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COMPUTATIONAL  FLUID  DYNAMICS  AND  AEROTHERMODYNAMICS 


(Development  of  Nonequilibrium  Models  Applicable  to  AOTV/AFE  and 
Superorbital  Flight  Regimes) 

I.  Introduction 

This  report  summarizes  the  activities  and  accomplishments  associated  with 
Texas  A&M  Research  Foundation  Project  5671  which  was  -funded  as  a subportion  o-f 
NASA  Grant  No.  NAG  9-192  -from  the  NASA  Johnson  Space  Center.  This  project 
was  awarded  January  6,  1987  and  actively  continued  until  December  6,  1988.  The 
primary  objective  o-f  this  e-f-fort  was  the  development  of  nonequilibrium  radiation 
and  chemistry  models  suitable  for  engineering  applications  associated  with  the 
flowfields  about  aero-assisted  orbital  transfer  vehicles  (AOTVs),  the 
aero-assosited  flight  experiment  vehicle  (AFE),  and  other  vehicles  operating  at 
superorbital  velocities  and  very  high  altitudes. 

II.  Personnel 

While  the  project  was  officially  awarded  in  January  1987,  the  fiscal 
paperwork  was  not  completed  for  several  months  and  actual  work  was  not 
permitted  to  start  until  mid-spring  1987.  However*  since  that  date  did  not 
correspond  to  the  beginning  of  an  academic  semester*  the  graduate  students 
planned  for  the  project  were  not  immediately  available.  In  late  spring,  Mr.  Glenn 
J.  Bobskill  was  assigned  to  the  project  as  a research  assistant;  and  in  June  1987 
Mr.  Robert  B.  Greendyke  joined  the  team*  also  as  a research  assistant.  Both 
students  officially  remained  with  the  project  thru  May  1988.  Both  Mr.  Greendyke 
and  Mr.  Bobskill  used  their  research  work  on  the  project  as  the  basis  for  their 
master's  theses;  and  both  received  their  M.Sc.  degrees  in  August  1988.  In 
addition,  Mr.  Thomas  Gaily,  who  is  a doctoral  student*  worked  on  the  project  at 
various  times.  At  the  present  time,  Mr.  Gaily  is  continuing  the  work  initiated  on 
this  project  on  a NASA  Graduate  Student  Researcher  Fellowship  from  the  NASA 
Johnson  Space  Center. 

Originally,  the  work  proposed  for  this  effort  was  only  supposed  to  last  for  one 
year.  However,  since  paperwork  delayed  the  effective  start  of  the  project  until 
June  1987,  it  was  immediately  extended  until  June  1988.  Subsequently,  in  order 
to  allow  the  presentation  of  results  at  the  AIAA  Thermophysicfi,  Plasmadynamics, 
and  Lasers  Conference  in  June  1988  and  to  permit  the  development  of  final 
versions  of  various  computer  codes,  reports,  etc.,  the  project  was  extended  until 
December  1988.  However,  from  a funding  and  accomplishments  standpoint,  almost 
all  work  on  the  project  was  completed  before  the  end  of  August  1988. 

The  principal  investigator  for  this  project  has  been  Dr.  Leland  A.  Carlson, 
Professor  of  Aerospace  Engineering. 

III.  Accomplishments 

In  this  section  the  primary  accomplishments  and  achievements  of  this  project 
will  be  briefly  discussed  and  summarized.  In  most  cases,  complete  details  are 
available  in  the  various  appendices  of  this  report. 
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The  primary  results  of  this  project  are  contained  in  the  following  publications: 

AIAA  Paper  No.  88-2672:  Carlson*  L.  A.*  "Approximations  for  Hypervelocity 

Nonequilibrium  Radiating*  Reacting,  and  Conducting  Stagnation  Regions," 
Presented  at  the  AIAA  Thermophysics,  Plasmadynamics,  and  Lasers  Conference, 
June  27-29,  1988,  San  Antonio,  Texas.  Accepted  for  publication  in  the  Journal  of 
Thermophysics  and  Heat  Transfer. 

AIAA  Paper  No.  88-2673:  Carlson,  L.  A.,  Bobskill,  G.  J.,  and  Greendyke,  R.  B., 
"Comparison  of  Vibration  Dissociation  Coupling  and  Radiative  Heat  Transfer 
Models  for  AOTV/AFE  Flowfields",  Presented  at  the  AIAA  Thermophysics, 
Plasmadynamics,  and  Lasers  Conference,  June  27-29,  1988,  SAn  Antonio,  Texas. 
Scheduled  for  publication  in  the  Journal  of  Thermophysics  and  Heat  Transfer  in 
October  1989. 

Master's  Thesis:  Bobskill,  Glenn  James,  "A  Comparative  Study  of  Reaction  Rate, 
Species,  and  Vibration-Dissociation  Coupling  Models  for  an  AOTV  Flowfield," 
Master  of  Science  Thesis,  Aerospace  Engineering,  Texas  A&M  University,  College 
Station,  Texas,  August  1988. 

Master's  Thesis:  Greendyke,  Robert  Brian,  "A  Parametric  Study  of  Shock  Jump 

Chemistry,  Electron  Temperature,  and  Radiative  Heat  Transfer  Models  in 
Hypersonic  Flows,"  Master  of  Science  Tehsis,  Aerospace  Engineering,  Texas  A&M 
University,  College  Station,  Texas,  August  1988. 

These  AIAA  papers  and  theses  are  contained  in  Appendices  1,  2,  and  4 of  this 
report. 

In  addition  the  following  paper,  which  is  based  upon  work  initiated  under  the 
present  project,  will  be  presented  next  summer: 

Carlson,  L.  A.  and  Gaily,  T.  A.,  "The  Effect  of  Electron  Temperature  and  Impact 
Ionization  on  Martian  Return  AOTV  Flowfields,"  To  be  presented  at  the  AIAA 
24th  Thermophysics  Conference,  June  12-15,  1989,  Buffalo,  New  York. 

Besides  these  publications,  several  computer  programs  have  been  developed 
as  part  of  this  project.  In  general,  these  codes  can  be  classified  as  either  being 
approximate  or  detailed.  The  approximate  code,  called  RAPROX,  is  designed  to 
provide  rapid  flowfield  and  heat  transfer  estimates  for  the  stagnation  region  of 
vehicles  in  the  11-18  km/sec  range,  and  thru  a series  of  approximations  is 
designed  to  include  the  effects  of  thermal  conduction,  chemical  nonequilibrium, 
and  nonequilibrium  nongray  radiative  transfer.  Predictions  obtained  with  the 
method  show  reasonable  agreement  with  the  Fire  2 flight  experiment  and  with  the 
results  of  other  investigators  (Ref.  1).  However,  parametric  studies  conducted 
with  the  method  indicate  that  further  studies  of  vacuum  ultra-violet  (VUV) 
processes  and  radiation  models  is  needed.  This  method  is  discussed  in  detail  in 
AIAA  Paper  88-2672  (Ref.  2)  contained  in  Appendix  1.  Further,  user  instructions, 
a listing,  and  sample  results,  are  presented  in  Appendix  5. 

The  detailed  code  is  an  inviscid  nonequilibrium  chemistry  axisymmetric  inverse 
code  based  upon  the  work  of  Grosse  (Ref.  3).  However,  it  has  been  extensively 
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modified  -to  include  a variety  o-f  vibration-dissociation  chemistry  options;  and 
models  for  radiative  nonequilibrium  effects,  electron  temperature,  and  radiative 
heat  transfer  computations  have  been  developed  and  included.  Both 
microcomputer  and  mainframe  versions  of  the  code  have  been  created. 
Fortunately,  or  unfortunately,  depending  upon  viewpoint,  this  code  has 
experienced  continual  change  as  new  phenomena  were  discovered  and  models 
developed.  Consequently,  several  different  versions  of  the  code  currently  exist. 
These  various  versions,  which  differ  primarily  in  reaction  chemistry  details  and 
electron  temperature  models,  are  presented  and  discussed  in  Appendix  6. 

The  primary  results  obtained  with  this  code  were  presented  in  Ref.  (4),  which 
is  reprinted  in  Appendix  i,  and  in  the  results  presented  in  Appendices  2 thru  4. 
The  primary  conclusions  were: 

(1)  At  the  exit  trajectory  point  for  the  AFE,  simplified  reaction  schemes  can  yield 
useful  results  at  significant  computational  savings,  providing  that  ionized 
species  are  not  of  interest. 

(2)  A modified  coupled  vibration  dissociation  vibration  coupling  scheme  (MCVDV) 
was  shown  to  yield  reasonable  vibrational  and  electron  temperature  profiles  as 
well  as  species  concentration  variations. 

(3)  At  entry  and  Max  0.  trajectory  points  for  the  AFE,  detailed  reaction  systems 
are  required  in  order  to  properly  predict  the  charged  species  affecting  the 
radiative  heat  transfer.  Further,  the  results  are  sensitive  to  the  electron  impact 
ionization  rate;  and  further  study  to  properly  model  ionization  chemistry  is 
needed. 

(4)  Nonequilibrium  siginifcantly  affects  the  radiative  heat  transfer,  and  both 
molecular  and  atomic  nonequilibrium  radiation  correction  factors  are  essential  for 
proper  prediction.  However,  radiative  cross-sections  and  absorption  coefficient 
models  based  on  equilibrium  results  can  be  used  provided  they  are  corrected  for 
nonequilibrium  radiation  phenomena. 

(5)  The  treatment  of  line  radiation  at  the  low  density  AFE  conditions  needs 
further  study  and  refined  radiation  models  suitable  for  engineering  calculations 
need  to  be  developed. 

As  indicated  above,  the  primary  efforts  on  this  project  were  completed  during 
the  summer  of  1938.  However,  a low  level  of  effort  has  been  continued  by  the 
principal  investigator  and  several  interesting  developments  have  occurred  since 
the  last  progress  report. 

First,  results  obtained  with  both  the  approximate  model  and  the  detailed  code 
indicated  that  of  the  radiation  cross-section  models  studied,  the  eight  step  model 
due  to  Olstad  (Ref.  5)  was  the  best.  In  addition,  during  the  summer  of  1983  a copy 
of  the  detailed  radiation  transport  model/code  RADICAL,  which  was  developed  by 
NASA  Langley  and  based  upon  Ref.  (6),  was  obtained.  Consequently,  comparison 
studies  between  the  eight-step  model  and  RADICAL  were  conducted.  These 
studies  revealed  that  the  cross-sections  predicted  by  the  eight-step  model  for 
the  wavelength  region  1130-1801  angstroms,  which  predominantly  contains  atomic 
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lines,  were  high.  Subsequent  investigation  indicated  that  Olstad  had  multiplied 
his  original  values  -for  this  region  by  a -factor  of  20  to  account  for  revised  f 
numbers.  However,  examination  of  the  various  f numbers  revealed  that  perhaps 
an  average  increase  of  eight  would  have  been  more  appropriate.  Thus,  the  Olstad 
values  for  the  region  in  question  were  divided  by  2.5  and  new  comparisons  with 
RADICAL  computed.  These  new  results  agreed  very  well  with  RADICAL,  and  thus 
the  radiation  models  in  RAPROX  and  the  AFE  codes  were  appropriately  modified. 

Second,  during  the  fall  of  1988  an  electron  temperature  model  based  upon 
quasi-equilibrium  locally  was  developed  and  a preliminary  version  incorporated 
into  several  of  the  AFE  codes  as  an  option.  This  new  model  determines  the  free 
electron  temperature  and  takes  into  account  both  elastic  and  inelastic  collision 
effects,  including  electron  impact  ionization.  Thus,  the  new  codes  actually  are 
"three-temperature"  in  that  they  predict  heavy  particle  or  translational 
temperature,  free  electron  temperature,  and  vibrational  temperatures  for  each 
diatomic  species.  The  versions  discussed  in  Ref.  (4)  assumed  that  the  electron 
temperature  was  equal  to  the  nitrogen  vibrational  temperature.  It  is  believed 
that  this  new  model  will  be  more  valid  than  the  previous  version  at  velocities 
above  li.5  km/sec,  where  free  electrons  dominate  the  ionization  chemistry  and 
the  radiation. 


Third,  the  validity  of  various  electron  impact  ionization  rates  and  models  is  in 
the  process  of  being  studied.  In  particular,  solutions  have  been  obtained  using 
various  proposed  rates  along  with  various  electron  temperature  models.  In 
addition,  the  ionization  model  in  the  programs  is  in  the  process  of  being  modified 
to  account  for  a two  step  process.  In  other  words,  it  is  assumed  that  ionziation 
proceeds  via  collisional  excitation  to  an  excited  state  followed  by  subsequent 
rapid  ionization.  The  preliminary  results  indicate  significantly  different 
flowfield  predictions  can  result  based  upon  which  model  is  used.  It  is  anticipated 
that  these  studies  will  be  presented  at  the  next  AIAA  Thermophysics  Meeting 
along  with  comparisons  of  existing  experimental  data. 

Fourth,  in  the  MCVDV  vibration  dissociation  coupling  model  used  in  the  AFE 
codes  the  vibrational  relaxation  time  predicted  by  Millikan  and  White  type  of 
correlations  is  corrected  to  prevent  unrealistically  short  relaxation  times,  i.e. 


t 


1 

X + 

MW  N C ^ 

V 


where  C = SO.RT(8kT//l/m)  and  according  to  Park  (Ref.  7) 


50000  2 

SI  = (IE-17)  t ] 

T 


is  a good  correlation  for  the  vibrational  excitation  cross  section.  For  the 
nonequilibrium  region  immediately  near  the  shock  front,  this  expression  will  yield 
values  around  5E-17.  However,  Park  (Ref.  8)  and  others  (Gnoffo,  private 
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communcation)  have  previously  used  values  as  high  as  IE-16  -for  this  cross 
section.  For  the  AFE  flight  regime,  these  differences  can  change  the  vibrational 
relaxation  time  by  an  order  of  magnitude  and  signifcantly  change  the  vibrational 
temperature  and  subsequently  the  electron  temperature  and  chemistry  profiles. 
In  turn,  the  radiative  heat  transfer  predictions  can  also  be  varied  significantly. 
Consequently,  a series  of  preliminary  studies  have  been  conducted  to  investigate 
this  effect.  Specifically,  results  have  been  obtained  for  several  trajectory  points 
in  which  the  leading  coefficient  in  the  G v equation  has  been  either  IE-17  or 
IE-16. 

Fifth,  in  spite  of  the  effort  in  the  present  project,  there  is  still  considerable 
uncertainty  concerning  the  application  and  use  of  the  present  nonequilibrium 
radiation  model,  or  for  that  matter  any  nonequilibrium  radiation  model,  in  the 
AFE  flight  regime.  At  higher  velocities,  say  12  km/sec,  where  the  degree  of 
ionization  is  large  (i.e.  electron  mole  fractions  around  0.20),  there  are  sufficient 
electrons  so  that  electron  impact  ionization  dominates  the  chemistry  and  that  a 
computed  free  electron  temperature  has  meaning.  Under  such  conditions,  the 
presence  of  thermal  and  chemical  nonequilibrium  should  significantly  affect 
populations  in  excited  electronic  states  and  the  nonequilibrium  radiation 
correction  factors  developed  in  the  present  effort  should  be  appropriate  and 
adequate. 

However,  at  the  AFE  max  Q trajectory  point  (8.915  km/sec,  15.715  d'/nes/sq 
cm,  197.101  K),  the  mole  fraction  Df  electrons  is  less  than  one  percent.  Under 
these  conditions  there  might  be  insufficient  electrons  for  the  excited  states  of 
atoms  to  be  in  equilibrium  with  the  ions  and  free  electrons  at  the  local  free 
electron  temperature,  and  it  might  be  more  likely  that  the  temperature 
characterizing  the  electronic  excited  states  of  both  atoms  and  molecules  would  be 
closer  to  the  nitrogen  vibrational  temperature  due  to  strong 
vibrational-electronic  coupling.  This  type  of  coupling  is  essentially  what  was 
assumed  in  Ref.  (4)  when  Te  was  assumed  equal  to  Tyj^.  Further,  it  might  be 
reasonably  assumed  that  the  atomic  electronic  states  would  be  populated 
according  to  a Boltzmann  equilibrium  distribution  at  the  vibrational  temperature. 
It  should  be  noted  that  this  is  not  what  was  assumed  in  Ref.  (4),  where  atomic  and 
molecular  nonequilibrium  correction  factors  were  both  used. 

This  latter  possibility  is  borne  out  by  some  detailed  nonequilibrium  radiation 
results  presented  by  Park  (Ref.  9)  for  a condition  similar  to  the  max  Q.  point.  His 
results  indicate  that  the  excited  electronic  states  of  nitrogen,  particularly  those 
near  the  3s4P  level,  essentially  follow  a Boltzman  distribution  at  the  assumed 
electron  temperature.  On  the  other  hand,  Park's  corresponding  predictions  for  the 
nonequilibrium  excitation  of  N2  molecules  shows  that  the  molecular  electronic 
states  are  not  populated  according  to  a Boltzman  distribution  and  that  typically 
the  numbers  in  each  excited  state  are  one  or  more  orders  of  magnitude  lower  than 
that  predicted  by  a Boltzman  distribution  at  Te,  Thus,  for  engineering 
calculations  with  methods  like  the  AFE  codes,  it  might  be  reasonable  to  assume 
at  the  max-Q  point  that  Te  = TvN2>  that  the  electronic  levels  of  the  atomic 
species  are  in  Boltzmanian  equilibrium  (no  atomic  correction  factors),  and  that 
molecular  species  are  in  radiative  nonequilibrium  (include  molecular  correction 
factors). 
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The  consequences  of  these  uncertainties  in  reaction  chemistry, 
vibration-dissociation  cut-off  values,  electron  temperature  models,  and  radiative 
nonequilibrium  models,  significantly  affects  the  predictions  of  radiative  heat 
transfer  at  trajectory  points  such  as  the  max-Q  points.  Predicted  values,  all 
obtained  using  the  eight  step  radiative  cross  section  model,  are  shown  on  Table  I 
for  various  assumptions. 


TABLE 
U = 8 

I — Results 
915  km/sec,  p 

Obtained  for 
infinity  = 

(jar  i ous  Models 
15.715  dynes/sq 

cm , 9 

cm  above  stag 

Case 

Te  Model 

V 

Rates 

Atm  Rad  Hoi . Rad 

VW  IW+Lines  Vis+IR 

Total 

1 

TW2 

IE-16 

RR3 

Noneq 

Noneq 

.33 

.27 

.52 

1.12 

2 

« 

a 

a 

Equil 

Noneq 

3.43 

2.32 

2.80 

8.55 

3 

1 

■ 

a 

Noneq 

Equil 

2.74 

4.17 

53.27 

60.18 

4 

fl 

■ 

a 

Equil 

■ 

5.15 

6.21 

55.54 

66.90 

5 

QE 

a 

a 

Noneq 

Noneq 

.32 

.21 

.31 

.85 

6 

■ 

a 

a 

Equil 

Noneq 

79.61 

41.53 

40.16 

161.30 

7 

t 

a 

s 

Noneq 

Equjil 

28.90 

55.94 

450.70 

535.60 

8 

1 

a 

a 

Equil 

Equil 

91.27 

96.56 

490.00 

477.90 

9 

TW2 

IE-17 

Wilson 

Noneq 

Noneq 

.03 

.03 

.05 

.10 

10 

1 

a 

a 

Equil 

Noneq 

.36 

.28 

.52 

1.16 

11 

a 

a 

a 

Noneq 

Equil 

.21 

.13 

5.45 

5.79 

12 

a 

a 

a 

Equil 

Equil 

.48 

.38 

5.92 

6.77 

13 

a 

1E-Id 

a 

Equil 

Noneq 

4.17 

2.84 

3.40 

10.40 

14 

QE 

IE-17 

a 

Noneq 

Noneq 

.03 

.02 

.03 

.08 

15 

a 

a 

a 

Equil 

Noneq 

39.06 

22.19 

23.83 

85.08 

Id 

a 

a 

a 

Noneq 

Equil 

14.80 

23.99 

263.20 

302.00 

17 

a 

a 

a 

Equil 

Equil 

45.98 

45.87 

286.70 

378.60 

18 

a 

IE-16 

a 

Noneq 

Noneq 

.02 

.02 

.03  .07 

NOTES 

All  radiative  heating  rates  in  watts/sq  cn. 

Number  in  3rd  column  is  leading  constant  in  correlation  for  v. 

BE  --  Te  determined  by  quasi-equilibrium  free  electron  temperature. 

TJN2  --  Te  assumed  equal  to  T^- 
RR3  — Reactions  and  rates  from  Ref.  (4). 

Wilson  --  Oxygen  ionization  reaction  in  RR3  replaced  by  0+  e=0-»  4 2e 

Rates  for  both  electron  impact  nitrogen  and  oxygen  ionization  are  based  upon  experiments  of 
Wilson  (Ref.  10). 


The  species  concentrations  and  vibrational  temperatures  used  for  the  cases 
marked  "RR3"  are  shown  on  Fig.  1?  of  Ref.  (A),  while  those  for  cases  denoted 
"Wilson"  are  shown  on  Figs,  (i)  and  (2)  in  this  report.  In  particular,  notice  on 
Figs.  (1)  and  (2)  the  significant  differences  in  the  vibrational  temperature 
profiles  due  to  the  differences  in  vibrational  excitation  cross  section  (lE-itS  vs. 
lE-i?  leading  coefficient).  While  not  as  obvious,  the  IE-16  case  also  exhibits 
faster  relaxation  and  lower  translational  temperatures  at  corresponding 
locations  due  to  the  shorter  vibrational  relaxation  time  and  corresponding  higher 
vibrational  temperatures,  which  enhance  dissociation.  In  addition,  these  results 
were  all  obtained  on  a microcomputer  using  only  20  streamlines.  While  in  many 
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cases  that  number  is  adequate#  to  be  conservative  these  values  should  not  be 
considered  "definitive"  but  should  be  used  -for  comparison  purposes.  Further# 
since  the  AFE  codes  are  inviscid#  the  radiative  heating  values  should  be  viewed 
as  the  flux  to  the  edge  of  the  wall  viscous  layer.  Since  a considerable  portion  of 
the  VUV  and  UV  radiation  should  be  absorbed  in  the  "cool"  viscous  layer#  the 
above  values  should  be  conservative.  However#  very  little  of  the  visible  plus  IR 
will  be  absorbed  in  the  viscous  layer. 

At  first  glance  the  results  presented  in  Table  I appear  to  be  confusing# 
particularly  considering  the  wide  range  of  values  presented.  However#  by 
comparing  various  cases  the  importance  of  individual  phenomena  can  be 
determined  and  insight  into  the  uncertainty  associated  with  various  facets  of  the 
problem  can  be  ascertained.  For  example#  the  sensitivity  to  reaction  systems  and 
rates  can  be  determined  for  this  trajectory  point  by  comparing  case  <2)  with  (13) 
and  case  (i)  with  (18).  These  indicate  that  if  atomic  electronic  states  are  in 
Boltzmanian  equilibrium  then  the  radiation  is  not  particularly  sensitive  to  atomic 
ionization  chemistry.  On  the  other  hand#  if  radiative  nonequilibrium  exists  for 
both  atomic  and  molecular  species  Hi  vs  183#  significant  sensitivty  exists# 
although  both  predictions  from  these  latter  two  cases  are  fairly  small. 

Likewise#  the  sensitivity  to  the  method  of  computing  the  electron  temperature 
used  in  the  radiation  calculations  can  be  observed  by  comparing  cases  (1-4)  with 
cases  (5-8)  respectively  and  (9-12)  with  (14-17).  These  results  show  that  if  any 
of  the  electronic  states#  either  molecular  or  atomic#  are  in  Boltzman  equilibrium 
a*  Te  that  the  radiative  heating  predictions  are  very  sensitive  to  the  Tg  model; 
although#  if  radiative  nonequilibrium  is  assumed  for  atoms  and  molecules#  the 
sensitivity  to  electron  temperature  modeling  is  considerably  less. 

Similarly#  the  dependence  of  the  results  on  the  leading  constant  in  the 
vibrational  excitation  correlation  can  be  estimated  by  examining  cases  (10)  and 
(13)  for  the  situation  where  atomic  levels  are  assumed  to  be  in  radiative 
equilibrium.  These  two  results  show  about  an  order  of  magnitude  difference# 
indicating  strong  dependence  upon  vibrational  and  vibration-dissociation  coupling 
phenomena.  On  the  other  hand#  cases  (9)  and  (18)  state  that  when  radiative 
nonequilibrium  is  considered  for  all  species#  that  the  vibrational  excitation  cross 
section  effect  is  less  and  in  the  opposite  direction. 

By  comparing  case  (1)  with  (2)  and  (9)  with  (10)#  the  effect  of  assuming 
radiative  equilibrium  or  nonequilibrium  in  atomic  species  can  be  observed  for  the 
situation  where  Tp  = *^'vN2 ’ anc*  the  resu^s  indicate  that  atomic  radiative 
equilibrium  leads  to  approximately  a 1-7  watts/sq  cm  increase  in  the  radiative 
heating  predictions*  depending  upon  the  vibrational  excitation  cross  section. 
However#  when  Te  is  determined  by  a quasi-equilibrium  electron  temperature 
model#  cases  (5)  and  (6)  and  (14)  and  (15)  show  that  the  existence  of  radiative 
equilibrium  among  atomic  states  has  the  potential  of  increasing  heating 
predictions  by  80  to  160  watts/sq  cm,  indicating  extreme  senstivity  to  electron 
temperature  modeling. 

Likewise#  the  sensitivity  to  molecular  radiative  nonequilibrium  is  indicated  by 
cases  (1)  vs  (3)  and  (9)  vs  (11)  for  Te  = tvN2  and  by  (5)  vs  (7)  and  (14)  vs  (16)  for 
Te  from  quasi-equilibrium.  In  the  latter  case  the  existence  of  radiative 
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equilibrium  -for  molecular  species  leads  to  extremely  large,  and  hopefully 
"incorrect",  radiative  heating  increases  of  300  to  500  watts/sq  cm;  while  in  the 
■former  case  assuming  molecular  radiative  equilibrium  leads  to  smaller  increases 
ranging  -from  5 to  60  watts/sq  cm. 

Considering  the  wide  range  of  predictions  depending  upon  models  and 
assumptions  selected  the  question  arises  Which  prediction  is  the  "best  guess"? 
As  previously  indicated,  at  the  max-O.  trajectory  point  the  amount  of  ionization  is 
very  low  and  there  is  evidence  that  atomic  electronic  states  may  be  near  Boltzman 
equilibrium  while  molecular  electronic  states  could  have  significant  radiative 
nonequilibrium.  In  addition,  for  this  case  temperatures  over  much  of  the  shack 
layer  are  fairly  low  (8000  - 10,000  K)  and  electronic  vibrational  coupling  should  be 
significant.  In  fact,  Ref.  (11)  states  that  the  vibration-electronic  relaxation  time 
for  N2  is  smallest  (and  hence  coupling  the  greatest)  at  7000  K.  Further,  this 
author  intuitively  favors  the  vibrational  temperature  profiles  for  cases  where 
the  vibrational  excitation  cross  section  leading  coefficient  is  IE-16.  Thus,  the 
"best  guess"  cases  for  the  max-O.  trajectory  point  might  be  cases  (2)  and  (13). 
Interestingly,  the  radiative  heating  predictions  in  the  visible  and  infrared  from 
these  two  cases  is  in  reasonable  agreement  with  the  results  of  Ref.  (11)  when  it 
is  realized  that  the  present  predictions  are  for  a location  nine  cm  above  the  axis. 
Of  course,  this  "agreement"  may  be  serendipity,  especially  when  it  is  recognized 
that  cases  (11)  and  (12)  predict  about  the  same  values. 

At  higher  velocities,  the  above  assumptions  would  not  be  as  correct  and  in 
many  cases  would  definitely  be  incorrect.  By  12  km/sec,  the  amount  of  ionization 
would  be  significant,  free  electrons  would  dominate  the  ionization  chemistry  and 
electronic  level  excitation,  and  dissociation  would  be  very  rapid.  In  those  cases, 
it  probably  would  be  better  to  assume  radiative  nonequilibrium  for  both  atomic 
and  molecular  species  and  to  use  as  the  electron  temperature  the  value  predicted 
by  an  appropriate  free  electron  equation  model. 

IV.  Conclusion 

As  demonstrated  above  and  in  the  appendices,  considerable  progress  has  been 
made  under  the  present  grant  in  the  development  of  nonequilibrium  chemical  and 
radiative  engineering  models  for  AOTV/AFE  high  altitude  flight  regimes. 
However,  the  present  effort  has  also  demonstrated  that  radiative  heating 
predictions  for  a typical  AFE  vehicle  are  very  sensitive  to  the  existence  or 
nonexistence  of  radiative  nonequilibrium  among  the  atomic  electronic  states  and 
to  the  values  predicted  for  electron  temperature.  Thus,  additional  research  work 
is  needed  in  the  area  of  electron  electronic  energy  equation  modeling;  and  current 
engineering  approaches  to  modeling  atomic  radiative  nonequilibrium  phenomena 
need  to  be  refined.  In  addition,  it  would  be  desirable  to  establish  both 
experimentally  and  theoretically  the  existence  and  degree  of  molecular  radiative 
nonequilibrium  at  AFE  conditions  since  molecular  radiative  equilibrium  leads  to 
extremely  high  heating  rate  predictions. 
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ABSTRACT 

A Comparative  Study  of  Reaction  Rate,  Species,  and  Vibration- 
Dissociation  Coupling  Models  for  an  AOTV  Flowfield 

(August  1988) 

Glenn  James  Bobskill,  B.S.,  Texas  A&M  University 
Chairman  of  Advisory  Committee:  Dr.  Leland  A.  Carlson 

An  analysis  was  conducted  using  various  combinations  of 
reaction  rates,  species,  and  vibrational  coupling  models  at 
three  different  AOTV  trajectory  points.  A comparative  study 
of  the  CVD,  CVDV,  CVDV-Pref erential , and  Park-Like 
vibrational  coupling  models  combined  with  three  reaction  rate 
sets  were  used  to  determine  the  best  modeling  combinations. 
The  conclusions  obtained  were  that  the  results  from  the  CVD 
model  were  considered  to  be  incorrect  due  to  the  model 1 s 
inability  to  compensate  for  the  effects  that  dissociation  and 
recombination  have  on  vibration,  that  additional  reaction 
rate  studies  were  needed  in  order  to  ascertain  the  validity 
of  the  electron  impact  rate  coefficients,  that  the  Park-Like 
model  produced  a better  representation  of  electron 
temperature  over  a wider  velocity  range  than  the  other 
models,  and  the  use  of  a smaller  reaction  rate  set  will 
produce  reasonable  results  with  a substantial  reduction  in 
computational  time. 
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NOMENCLATURE 


C - Molecular  velocity 

c^  - Mass  fraction  of  species  i 

E - Vibrational  energy  lost  during  single  dissociation 

F°  - Free  energy  at  standard  pressure 

G - Vibrational  energy  gained  during  single  recombination 
© 

h - Heat  of  formation  at  standard  pressure 

h - Enthalpy 

k^  - Backward  reaction  rate  coefficient 
kf  - Forward  reaction  rate  coefficient 

M - Molecular  specie 

N - Number  of  vibrational  energy  levels  to  dissociation 

Nq  - Avagadro 1 s number 

n - Number  density 

p - Pressure 

Q - Partition  function 

R - Universal  gas  constant 

Rc  - Radius  of  curvature 

T - Translational  temperature 

Ta  - Geometric  average  temperature 

T - TT/(T  + T ) 

Tv  - Vibrational  temperature 

U - Characteristic  probability  temperature 

- Component  of  velocity  parallel  and  normal  to  shock 

$1 
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NOMENCLATURE  (CONTINUED) 


a - Coefficient  used  in  vibrational  relaxation  time 

/3  - Temperature  exponent,  vibrational  relaxation  time 

ev  - Vibrational  energy 

6V  - Characteristic  vibrational  temperature 

A - Scale  factor  (1  - y)/R 

G 

P - Chemical  potential 

Mjjj  - Molecular  weight  of  species  i 


v 


P 


<P 

* 


o> 

n 


- Stoichiometric  coefficient 

- Mags  density 

- Coefficient  used  in  vibrational  relaxation  time 

- Collisional  cross  section 

- Vibrational  relaxation  time 

- Corrected  vibrational  relaxation  time 

- Coupling  factor 

- Stream  function 

- Rate  of  production  of  species  n 

- Anharmonic  oscillator  coefficients 


Subscripts: 
b - Body 

s - Shock 

co  - Refers  to  local  vibrational  equilibrium  or  freestream 
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INTRODUCTION 

In  recent  years,  there  has  been  a renewed  interest 
within  the  aerospace  industry  to  predict  the  chemical  and 
thermodynamic  quantities  in  a hypersonic  flowfield.  At 
present,  the  Aeroassisted  Orbital  Transfer  Vehicle  (AOTV) 
represents  one  of  the  current  and  future  applications  of 
hypersonic  flowfield  research  within  the  aerospace  community. 
The  AOTV  performs  an  aerobraking  maneuver,  using  atmospheric 
drag  to  reduce  kinetic  energy,  to  enable  the  vehicle  to 
transition  from  a higher  geosynchronous  orbit  to  a lower 
earth,  orbit  without  expending  available  energy  ’ resources. 
From  a practical  standpoint,  the  use  of  this  device  would 
decrease  the  cost  and  increase  the  payload  size  of  future 
missions  in  space.  Some  examples  of  various  AOTV 

configurations  are  displayed  in  Figure  1.  The  velocity  and 
altitude  range  normally  encountered  during  a geosynchronous 
to  a lower  earth  orbit  maneuver  is  about  7 to  11  kilometers 
per  second  at  70  to  100  kilometers,  Furthermore,  the  maximum 
dynamic  pressure  point  (Qmax  or  max-Q)  encountered  during 
this  manuever  occurs  at  an  altitude  of  approximately  75 
kilometers . 

These  mission  requirements,  at  their  respective 
altitudes  and  velocity  ranges,  have  made  apparent  the  need  to 
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FIGURE  1.  GENERIC  AOTV  CONFIGURATIONS 
(Adapted  from  References  1 and  2) 
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develop  methods  which  would  yield  good  engineering  results 
and  at  the  same  time  be  computationally  efficient.  One 
technique  which  fulfills  these  requirements  is  an  inviscid 
method  developed  by  Maslen3.  Maslen’ s approach  involves  the 
solution  of  the  momentum  and  energy  equations,  within  the 
transformed  von  Mises  plane,  as  functions  of  a given  the  x 
shock  coordinate  and  a stream  function.  The  Maslen  method  is 
an  inverse  formulation  in  which  the  shock  shape  is 
mathematically  specified  in  a two  dimensional  coordinate 
system  and  the  subsequent  flow  parameters  and  body  shape  are 
then  determined  as  part  of  the  final  solution.  Later,  Grose4 
extended  the  Maslen  type  approach  by  including  chemical  and 
thermal  nonequilibrium  effects  and  applying  them  to  various 
planetary  atmospheres. 

The  rate  at  which  chemical  relaxation  occurs  behind  a 
strong  shock  wave  strongly  affects  on  all  chemical  and 
thermodynamic  quantities  in  a high  speed  flowfield.  These 
chemical  relaxation  processes  are  governed  primarily  by 
chemical  reaction  rates  and  the  change  in  vibrational  energy 
for  each  diatomic  species  component  during  collisional 
exchanges.  This  process  of  chemical-kinetic  interaction 
displays  a continuous  energy  exchange  between  the  vibrational 
modes  of  motion,  the  dissociation,  and  recombination 
processes  that  take  place  within  the  region  of  relaxation. 
Vibration— dissociation  coupling  models  are  used  to  describe 
these  energy  exchanges.  Thus,  they  significantly  affect  the 
determination  of  the  correct  species  concentration, 
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vibrational  temperature,  and  other  thermodynamic  quantities. 

The  objective  of  the  research,  as  outlined  within  this 
thesis,  was  to  perform  a comparative  study  of  various 
species,  reaction  rate  models,  and  vibration-dissociation 
coupling  models  within  the  proposed  AOTV  flight  trajectories. 
In  addition,  an  analysis  was  performed  to  determine  which 
combinations  of  species,  chemical  reaction  rates,  and 
vibrational  coupling  models  were  necessary  to  properly 
describe  the  chemical  and  vibrational  relaxation  processes 
for  the  AOTV.  The  program  listed  in  Reference  4 was  modified 
to  perform  this  study. 
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BACKGROUND 


It  has  been  revealed  through  previous  experimental 
studies  that  the  processes  of  vibrational  relaxation, 
dissociation,  and  recombination  do  not  occur  independently; 
but  rather,  each  process  influences  the  other  through 
continuous  energy  exchanges.  Vibration-dissociation  coupling 
models  which  are  used  in  an  attempt  to  describe  this  kinetic 
process  are  fundamentally  based  on  the  dissociation  of  a pure 
diatomic  gas  as  derived  from  thermochemical  concepts.  Several 
past  and  present  investigations  have  produced  viable  models 
which  are  included  within  the  present  comparative  study. 

The  first  model  used  in  this  analysis  is  the 

5 

Coupled-Vibration-Dissociation  model  (CVD) . The  CVD  model  is 
comprised  of  essentially  two  mathematical  expressions  which 
are 
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Equation  (1)  describes  the  rate  at  which  the  vibrational 
energy  changes  due  to  collisions  and  also  assumes  that  the 
molecules  can  be  represented  as  a system  of  simple  harmonic 
oscillators.  This  equation  describes  the  rate  of  change  of 
vibrational  energy  at  any  instant  as  being  linearly 
proportional  to  the  amount  that  the  vibrational  energy 
differs  from  equilibrium  at  that  instant.  It  should  be  noted 
that  no  assumption  was  made  concerning  how  the  oscillators 
were  distributed  over  the  available  energy  levels  in  the 
original  derivation  of  equation  (1)  . In  particular,  the 
standard  assumption  of  a Boltzmann  distribution  was 
neglected.  The  Boltzmann  distribution  assumes  that  at 
sufficiently  high  temperatures,  the  particles  are  distributed 
over  a wide  range  of  permissible  energy  levels  and  that  the 
distributions  themselves  can  be  described  in  the  form  of 
partition  functions. 

Equation  (2)  is  referred  to  as  the  coupling  coefficient 
or  coupling  factor  which  couples  the  effects  of  vibrational 
nonequilibrium  to  the  dissociation  process.  The  coupling 
factor  is  defined  as  the  ratio  of  the  actual  forward  rate  to 
the-  forward  rate  that  would  exist  for  local  vibrational 
equilibrium.  The  final  form  of  equation  (2)  comes  about  from 
the  redefinition  of  the  forward  rate  ratio  in  the  form  of 
partition  functions.  The  substitution  of  the  vibrational 
partition  function  into  this  manipulation  redefines  the  Morse 
energy  curve  into  a system  of  harmonic  oscillators  cutoff 
just  prior  to  dissociation.  The  Morse  curve  is  a 

r* 
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representation  of  changes  in  vibrational  energy  as  a function 
of  intermolecular  distance.  As  the  distance  changes,  due  to 
vibration,  work  must  be  done  against  the  interatomic  forces. 
These  forces  are  attractive  at  large  distances  and  repulsive 
at  short  distances.  The  CVD  model  also  assumes  that 
dissociation  can  occur  with  equal  probability  from  any 
vibrational  level.  Details  of  this  derivation  are  outlined  in 
the  Appendix.  It  should  also  be  noted  that  the  program  given 
in  Reference  4 already  incorporates  the  CVD  model  and 
therefore  required  no  additional  modification. 

The  second  model  that  has  been  used  in  this  study  is  the 
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Coupled-Vibration-Dissociation-Vibration  ' model  (CVDV) . The 
vibrational  rate  equation  for  the  CVDV  model  is  comprised  of 
the  following  terms 
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The  CVDV  model  is  similar  to  the  CVD  model  to  the  extent  that 
they  share  the  same  basic  assumptions  and  formulation,  except 
that  equation  (3)  combines  the  vibrational  rate  equation  of 
the  CVD  model  plus  two  additional  terms.  These  additional 
terms  take  into  account  the  effect  that  dissociation  has  on 
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the  average  vibrational  energy  of  molecules  as  previously 
represented  by  a system  of  simple  harmonic  oscillators  which 
are  cutoff  just  prior  to  dissociation.  The  second  term,  the 
forward  process,  in  equation  (3)  represents  the  average 
energy  lost  from  vibration  due  to  a single  dissociation, 
while  the  third  term,  the  reverse  process,  represents  the 
amount  of  average  energy  gained  due  to  a single 

recombination . 

These  additional  terms  were  derived  based  on  the 
assumption  that  all  vibrational  levels  are  populated 

according  to  a Boltzmann  distribution  and  that  a Boltzmann 
distribution  is  maintained  during  dissociation  energy  losses. 
To  complete  the  CVDV  model,  a coupling  factor  identical  to 
that  of  the  CVD  model  is  used.  Like  the  CVD  model,  the 
coupling  coefficient  is  used  as  a correction  f actor . for  the 
forward  rate  constant  when  the  vibrational  mode  of  motion  is 
not  in  equilibrium. 

The  third  model  used  in  this  study  is  the 

Coupled-Vibration-Dissociation-Vibration7 ' 8 model  with 
preferential  dissociation  (CVDV- Preferential) . There  are 
important  differences  between  the  CVD,  CVDV,  and  the  CVDV- 
Preferential  models  which  arise  from  the  changes  in  the 
initial  assumptions.  The  first  assumption  states  that  the 
mechanism  of  vibrational  relaxation  progresses  to  a final 
Boltzmann  distribution,  based  on  an  equilibrium  temperature, 
and  that  it  occurs  through  a series  of  Boltzmann 

distributions.  The  second  assumption  was  that  • the 
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dissociation  processes  occur  with  equal  probability  from  any 
vibrational  level.  The  final  assumption  is  that  the 
vibrational  energy  system  is  modeled  as  a series  of  simple 
harmonic  oscillators  cutoff  prior  to  dissociation. 

In  order  to  present  a more  physically  correct 
representation  of  a physical  system,  it  would  be  natural  to 
change  any  assumptions  that  are  based  on  ideal  situations. 
Therefore,  the  second  and  third  assumptions  have  been  changed 
for  the  CVDV-Preferential  model.  The  resulting  model  is 
comprised  of  the  following  expressions 
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kf(T,Tv)  _ Q(T)Q(Tm) 

kM( T)  " Q(TV)Q(-U) 


The  individual  terms  depicted  in  equation  .(4)  are 
defined  in  the  same  manner  as  for  the  CVDV  model  except  that 
a greater  probability  of  dissociation  has  been  assigned  to 
the  higher  vibrational  energy  levels.  This  preferential 

treatment  and  control  of  the  higher  energy  levels  is 

accomplished  in  the  following  manner.  First,  the  Morse 

vibrational  energy  curve  is  replaced  by  an  anharmonic 
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oscillator  and  mathematically  represented  by  the  following 
Taylor  series  expansion9 

Ev  = ue(cv  + X/2)  - «e^e(cv  + 1/2) 2 + «eye(cv  + 1/2) 3 

" weze(cv  + 1/2^  (6) 

The  expansion  coefficients  in  equation  (6)  have  been 
determined  experimentally  and  are  listed  in  Reference  9 for 
most  monatomic,  ionic,  and  diatomic  species  of  air.  The  final 
step  in  preferential  control  is  the  selection  of  a 
characteristic  probability  temperature,  which  is  located  in 
the  denominator  of  equation  (5)  . A typical  value  of  this 
temperature  is  assumed  to  be  approximately  one  third  to  one 
sixth  of  the  ideal  dissociation  temperature8.  It  should  be 
n°hed  that  as  the  characteristic  probability  temperature 
approaches  infinity,  an  equal  probability  of  dissociation  is 
assigned  to  each  energy  level.  This  condtion  corresponds  to 
the  previous  assumptions  of  the  CVD  and  CVDV  models. 

The  final  vibrational  coupling  model  used  in  this  study 
is  the  two-temperature  chemical-kinetic  model  (TT  ) developed 
by  Park10.  The  TTv  model  assumes  that  the  rotational 
temperature  is  characterized  by,  or  in  equilibrium  with,  the 
translational  temperature  and  that  the  electronic  and 
electron  temperatures  are  in  equilibrium  with  the  vibrational 
temperature.  The  total  rate  of  change  of  vibrational  energy, 
as  described  by  - Park,  is  the  summation  of  four  individual 
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components.  These  components  include  the  contributions  of 
heavy  particle  and  electron  collisions  as  well  as  the  removal 
of  vibrational  energy  due  to  dissociation.  Park  also  assumed 
a change  in  the  functional  dependency  of  the  forward  reaction 
rates.  Since  the  TTv  model  is  based  on  two  temperatures,  the 
forward  reaction  rates  with  a general  collision  partner  were 
based  on  a geometric  average  temperature 


(7) 


After  several  unsuccessful  attempts  of  trying  to 
incorporate  the  original  Park  model  into  the  present  computer 
algorithm,  a Park-Like  model  was  created  for  this  study. 
These  unsucessful  attempts  were  characterized  by  an  inability 
to  conserve  mass  at  points  in  the  flowfield,  which  appeared 
to  be  related  to  the  use  of  T in  the  the  forward  reaction 

a. 

rates.  The  resulting  Park-Like  model  contained  the  first  term 
of  the  TTv  vibrational  rate  expression  with  its  limited 
collisional  cross  section  and  diffusion  modification,  plus 
the  second  and  third  terms  of  the  CVDV  model  in  accordance 
with  the  description  in  Reference  10.  The  geometric-  average 
temperature  located  in  the  forward  rates  was  replaced  by  the 
CVDV  coupling  factor.  This  substitution'  gave  an  equivalent 
effect  similar  to  the  average  geometric  temperature  by 
slowing  the  forward  dissociation  processes.  The  Park-Like 
model  yielded  the  following  expressions 

li* 
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Equation  (8)  , which  in  the  present  study  has  only  been 
applied  to  nitrogen,  represents  the  vibrational  rate  equation 
of  the  CVD  model,  but  with  a correction  factor  on  the  first 
term  to  compensate  for  the  non-linear  behavior  of  the 
vibrational  energy  near  the  shock  front  at  extreme 
temperatures.  This  phenomenon  resembles  a diffusion  process; 
therefore,  the  coefficient  is  sometimes  referred  to  as  a 
diffusion  factor.  Equation  (9)  is  referred  to  as  a bridging 
formula  since  it  connects  the  diffusion  correction  to  the 
linear  behavior  of  vibrational  energy  as  originally  derived 
by  Landau-Teller  . Similarly,  the  set  of  expressions 
depicted  in  equation  (10)  are  corrections  to  the  vibrational 
relaxation  time  . These  expressions  arise  from  the  fact  that 
the  correlation  formulas  presented  in  Reference  12  do  not 
limit,  at  high  temperatures,  the  collisional  cross  section 
for  vibrational  relaxation  process.  Therefore,  a limiting 
collisional  cross  section  term  is  introduced  in  order  to 
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ensure  reasonable  vibrational  relaxation  times. 

The  determination  of  accurate  experimental  data  for 
vibrational  relaxation  times  as  a function  of  temperature  is 
a crucial  part  of  vibrational  coupling  model  evaluation. 
Since  some  theories  contain  gross  approximations,  which  have 
led  different  investigators  to  reach  opposing  conclusions,  it 
became  necessary  to  compare  existing  vibrational  relaxation 
data  and  to  make  an  appropriate  selection.  In  order  to  select 
a reliable  set  of  vibrational  relaxation  data,  a comparison 
has  been  made  between  the  experimental  data  of  Blackman13, 
Millikan  and  White12,  and  the  data  listed  in  Reference  2.  The 
data  in  Reference  2 used  the  functional  form  of  equation 
(11)  , which  is  the  standard  representation  of  vibrational 
relaxation  time  as  predicted  by  classical  • Landau-Teller 
theory. 
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while  that  in  References  12  and  13  were  of  the  form 


0 (<r  T_1/3) 

Pt  = a T e 


(12) 


These  experimental  time  correlations  for  nitrogen 
vibrational  relaxation  have  been  plotted  using  the  standard 
Landau-Teller  representation  of  log(pr)  versus  T-1//3 


and  are 
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presented  in  Figure  2.  Both  the  vibrational  relaxation  data 
of  Reference  2 and  Blackman  display  non-linear  behavior  over 
the  entire  temperature  range  due  to  their  functional  forms, 
while  the  Millikan  and  White  experimental  data  shows  a linear 
behavior  due  to  the  fact  that  £ in  equation  (12)  is  assumed 
to  be  zero.  As  can  be  seen,  the  Millikan  and  White  data  has  a 
greater  rate  of  change  with  temperatures  than  the  data  of 
References  2 and  13.  Nevertheless,  after  reviewing  these 
correlations  and  experiments14,  it  was  felt  that  the  Millikan 
and  White  representation  of  vibrational  data  was  the  most 
accurate;  therefore,  it  was  subsequently  used  for  this 
comparative  study. 
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CHEMICAL  KINETICS 


Many  mathematical  representations  can  be  used  to 
describe  a system  of  chemical  reactions  within  a flowfield; 
however,  such  descriptions  must  reflect  a coupling  of  the 
chemical  reactions  and  species  to  the  changing  flowfield 
quantities.  The  noneguilibrium  chemistry  formulation,  used  in 
Reference  4,  treated  the  forward  and  backward  reactions  as 
separate  forward  reactions  during  computation  and  required 
the  specification  of  both  the  forward  and  backward  reaction 
rate  coefficients.  For  a given  reaction,  chemical  rate  data 
is  not  always  available  for  both  directions;  and  therefore, 
it  became  necessary  to  modify  the  present  program  so  that  one 

specified  and  the  other  could  be  determined 
based  on  the  equilibrium  coefficient  of  the  reaction.  Since 
the  chemical  formulation  presented  in  Reference  7 had  this 
capability  of  dual  selection,  its  algorithm  was  incorporated 
into  the  present  research  program. 

A physical  system  undergoing  change,  due  to  collisional 
exchanges,  can  be  represented  or  described  by  a set  of 
chemical  reactions  and  species.  These  collisional  exchanges 
can  be  expressed  mathematically  by  the  following  expression, 


ns 


M, 


ns 


r i=l 


T v. 

L. ^ 1 fD  1 


(13) 


17 


where  i = 1,2,...., ns  indicates  the  number  of  species  and  j = 
1,2,.... , nr  indicates  the  number  of  reactions  within  a given 
system.  The  left  and  right  sides  of  equation  (13)  represent 
the  reactants  and  the  products  respectively.  The 
stoichiometric  coefficients  ( v ) indicate  the  number  of 
molecules  of  species  M for  both  the  products  and  the 
reactants. 

For  a condition  of  equilibrium  to  exist,  the  number  of 
depleting  collisions  must  equal  the  number  of  incoming 
collisions  within  a defined  system.  The  collision  rates,  as 
represented  by  a specific  reaction,  can  be  determined  by  the 

forward  and  backward  reaction  rate  coefficients  which  are 

> 

related  through  an  equilibrium  constant.  The  term  "constant" 
is  frequently  used  because  reaction  chemistry  is  often 
studied  experimentally  at  a fixed  translational  temperature. 

The  equilibrium  constant,  with  its  subsequent  reaction 
rate  expressions,  is  usually  represented  mathematically  as 
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In  turn,  the  equilibrium  constant  can  be  expressed  in  terms 
of  partial  pressures  through  the  change  in  free  energy  of  the 
given  chemical  reaction;  and  this  redefinition  of-  the 
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equilibrium  constant  leads  to 
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Equations  (16)  and  (17)  are  general  forms  of  the  law  of  mass 
action  for  mixtures  of  a thermally  perfect  gas.  The 
thermodynamic  state  variable  F° , known  as  the  Helmholtz  free 
energy,  is  normally  defined  as  the  difference  between  the 
total  and  irreversible  energies  of  a macroscopic  system. 
Using  the  statisical  thermodynamic  definition  of  free  energy, 
the  chemical  system  can  also  be  expressed  in  the  form  of 
chemical  potentials  summed  over  all  species  for  a specific 
reaction.  Therefore,  the  free  energy  can  be  represented  as 


RT 


ns 


/ 


(18) 


where 
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Equation  (19)  represents  the  chemical  potentials  of  a 
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Equation  (19)  represents  the  chemical  potentials  of  a 
microscopic  system  in  the  form  of  factored  partition 
functions  for  each  molecular  mode  of  motion.  The  standard 
heat  of  formation  term  in  equation  (19)  is  included  in  order 
to  reference  each  species  component  to  a common  energy  state. 

The  final  phase  in  describing  a physical  gas  system  is 
the  representation  of  the  chemical  production  rates,  which 
are  customarily  expressed  in  terms  of  the  concentrations  of 
individual  species.  This  mathematical  representation  is  based 
on  collision  theory  which  is  in  the  form  of  a general 
expression  derived  from  the  law  of  mass  action.  This 
representation  also  requires  that  the  rate  of  production  of  a 
given  species  be  directly  proportional  to  the  product  of  the 
concentrations  of  the  reacting  species  raised  to  the  power 
equal  to  its  stoichiometric  coefficient.  Therefore,  the  law 
of  mass  action  is  applied  to  equation  (13)  and  results  in  the 
following  rate  expression  for  general  production 
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where  the  notation  is  that  of  Reference  7.  Since  the  solution 
method  that  was  used  for  this  study  is  a function  of  a given 
x shock  coordinate  and  stream  function,  equation  (20)  must  be 
altered  accordingly  to 
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SOLUTION  METHOD  AND  ANALYSIS 


The  solution  technique  that  was  chosen  for  this  study  is 

3 

an  inverse  method  which  was  first  derived  by  Maslen  and 
later  modified  by  Grose4  to  include  chemical  nonequilibrium 
processes.  The  Maslen  method  is  formulated  in  a 
shock-oriented  or  curvilinear  coordinate  system  which  is 
shown  in  Figure  3.  The  governing  equations  for  continuity, 
momentum,  and  energy  are  then  transformed  into  the  Von  Mises 
plane.  The  governing  equations  in  the  non-trans formed 
coordinates  are 
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Equation  of  state: 

h = h(p, p,c1,c2, . . ,cn) 


(22) 

(23) 

(24) 

(25) 

(26) 

(27) 
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The  Von  Mises  transformation  allows  the  governing 
equations  to  be  redefined  so  that  the  independent  variables 
become  x,  distance  along  the  shock,  and  the  stream  function 
ip.  The  actual  transformation  equations  can  be  derived  from 
the  partial  derivative  of  the  stream  function  as  defined  from 
the  continuity  equation.  As  given  in  Reference  4,  these 
equations  are 
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(30) 


By  using  equation  (30) , the  transformed  expressions  for  the 
momentum  and  rate  equations  become 


(31) 


(32) 
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Again,  by  using  the  relationship  in  equation  (3  0)  and  the 
transformed  momentum  equations,  the  energy  equation  can  be 
obtained  in  the  (x,\b)  plane.  The  final  form  can  be  obtained 

lb 
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by  differentiating  equation  (25)  and  combining  it  with 
equations  (23)  and  (24)  which  yields 


By  utilizing  the  thin  shock  layer  approximation,  which 
assumes  that  the  flow  is  almost  parallel  to  the  shock,  a 
simplified  version  of  the  transformed  lateral  momentum 
equation  can  be  obtained.  Thus,  equations  (32)  and  (33)  can 
be  simplified  by  assuming  that  is  small  and  that  the 

scale  factor  X is  equal  to  one.  The  effect  of  these 
approximations  is  to  uncouple  the  lateral  momentum  equation 
from  the  remaining  equations  so  that  an  expression  for 
pressure  independent  of  the  flowfield  chemistry  can  be 
obtained.  Equation  (32)  can  then  be  integrated  on  a line 
normal  to  the  shock  to  obtain  the  pressure  as  a function  of 
the  specified  shock  geometry  and  flow  values  immediately 
behind  the  shock.  This  leads  to  the  following  approximation 
first  derived  by  Maslen 

P(X,«  = PS(X>  + -Rc-(^-^(X)  [ * - VX>  ] (35> 

Notice  that  equation  (3  5)  is  a function  only  of  the  shock 
geometry  and  shock  jump  chemistry.  In  a related  study  on 
shock  jump  chemistry  performed  by  Greendyke15,  oxygen,  or 
oxygen  and  nitrogen  were  assumed  to  immediately  dissociate  to 
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equilibrium  concentrations  at  the  shock  front,  and  the 
consequences  of  these  assumptions  on  computational  efficiency 
and  flow  properties  were  investigated. 

From  the  requirement  of  energy  conservation,  the 
velocity  at  any  point  in  the  flowfield  can  subsequently  be 

determined  based  on  the  parallel  shock  flow  approximation  of 

,2  2 . 2 
(v  - v ) « u 
s 


u 


(36) 


As  with  any  numerical  method,  the  proper  specification 
of  boundary  conditions  is  essential,  since  the  Maslen  method 
is  an  initial  value  problem,  the  specification  of  all 
starting  values  at  the  shock  front  are  determined  by  shock 
geometry,  assumed  shock  jump  chemistry,  and  freestream 
conditions.  In  addition,  the  stream  function  values 
associated  with  the  shock  and  the  body  are 
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p v rl 
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(37) 


(38) 


The  final  step  in  this  method  is  the  transformation  from 
the  curvilinear  coordinates  (x,\&)  back  to  the  physical  (z,r) 
space.  By  inspecting  Figure  3,  one  can  deduce  three  important 
transformations  from  trigonometry.  These  relations  are 
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r 


(39) 


= rg (x)  - y cos  eg(x) 
z = z fx)  + y sin  e (x)  (40) 

S o 

ug(x)  = cos  eg(x)  (41) 

where  equation  (41)  is  a reiteration  of  the  parallel  shock 
flow  assumption.  The  final  form  of  the  physical  space 
transformation  equation  is  obtained  by  first  inverting 
equation  (29)  and  then  integrating  with  respect  to  \p.  The 
resulting  equation  obtained  after  the  substitution  into 
equation  (39)  is 

r 
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SOLUTION  PROCEDURE 


An  inverse  method  is  a techingue  in  which  an  initial 
quantity,  other  than  a body-type  boundary  condition,  is 
specified.  From  an  initial  description  of  a shock  shape  using 
an  analytical  expression  of  the  form 


rs  " rs<z> 


(43) 


The  local  shock  angle,  radius  of  curvature,  and  distance 
along  the  shock  can  be  determined  by  the  following 
expressions 


e - tan 
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f dr. 


dz 


(44) 
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d2r 
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(45) 


,rs 


X = 


dr 

s_ 

sin  e 


0J 


(46) 


Initiation  of  the  solution  begins  with  the  determination  of 
these  geometric  shock  values  at  all  streamline  points,  which 
are  located  by  user  selected  values  of  delta-x  and  maximum  z . 
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In  addition,  preselected  freestream  values  of  temperature, 
pressure,  velocity,  and  gas  composition  are  used  to  compute 
the  freestream  density,  molecular  weight,  and  internal 
energy.  The  following  mathematical  expressions  are  used  in 
conjunction  with  a constraint  to  calculate  these  freestream 
quantities 
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max  -1 

w • 


m 


y -L- 

k "-i 


max 


E «i  - 


1=1 


max 


. = V c . e. 
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(47) 


(48) 


(49) 


(50) 


The  next  step  within  the  computer  algorithm  is  the 
determination  of  the  thermodynamic  state  of  the  gas 
immediately  behind  the  shock  wave,  which  is  sometimes 
referred  to  as  the*  shock  jump  condition.  This  condition 
usually  assumes  an  instantaneous  equilibration  of  the 
translational,  rotational,  and  electronic  contributions  to 
the  internal  energy  of  the  gas  at  some  translational 
temperature  Tg.  The  vibrational  contribution  to  the  internal 
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energy  can  be  treated  as  being  in  equilibrium  with  the 
translational  mode  or  as  being  in  vibrational  nonequilibrium 
as  modeled  through  a vibrational  coupling  model.  In  addition, 
the  species  concentrations  across  the  shock  are  assumed  to 
remain  constant  at  their  freestream  values,  which  is  referred 
to  as  frozen  flow. 

In  order  to  calculate  the  translational  temperature 
across  the  shock  front,  an  iterative  procedure  is  required  to 
solve  the  oblique  shock  relations.  These  relations  as 
expressed  from  the  conservation  of  mass,  momentum,  and  energy 
are 


A(X)  = 

V sin  e 

) oo  S 

(51) 

n(x)  = pw 

+ 

p V 2 sin2  e 

oo  oo  S 

(52) 

\ = & 4- 

P» 

V 2 sin2  e 
_ + s 

(53) 
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With  an  initial  estimate  of  T , values  of  internal  energy  and 
temperature  across  the  shock  front  can  be  calculated  using 
equation  (50)  and  the  following  relation 


(54) 


can  then  be  iterated  using  a Newton's  method 
S' 


Equation  (54) 
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until  subsequent  values  of  T differ  by  less  than  a 
preselected  tolerance.  Upon  convergence,  the  shock  jump 
values  of  pressure,  density,  enthalpy,  and  velocity  are 
evaluated  by 
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u = v cos  e 

S 00  S 


(58) 


The  next  step  in  the  solution  procedure  is  the 
determination  of  the  pressure  and  the  pressure  gradient  for 
the  entire  flowfield.  First,  the  pressure  is  evaluated  in  the 
(x,0)  plane  using  equation  (35).  Then,  the  value  of  the 
pressure  gradient,  which  is  used  primarily  to  evaluate  the 
change  in  enthalpy  along  a given  streamline,  is  computed 
through  second  order  finite  difference  representations.  This 
step,  as  well  as  the  aforementioned  steps,  provide  a set  of 
conditions  which  are  necessary  for  a stepwise 
evaluation  of  the  rate  of  change  associated  with  species 
concentrations,  vibrational  energy,  and  enthalpy  along 
streamlines . 

The  next,  and  most  important,  part  of  the  solution 

n 


algorithm  is  the  evaluation  of  the  partial  derivatives  along 
a given  streamline,  and  the  obtaining  of  the  flowfield 
properties  through  numerical  integration.  Unfortunately, 
there  is  an  undesirable  characteristic  associated  with  the 
governing  equations  which  model  chemically  reacting  flows. 
This  characteristic  corresponds  directly  to  the  so  called 
"stiff  behavior"  of  the  chemical  rate  equations,  which  are 
extremely  sensitive  to  step  size.  The  physical  reason  for 
this  behavior  is  the  rapidity  at  which  a set  of  chemical 
reaction  rates  can  change  during  dissociation,  recombination, 

and  ionization  processes. 

4 

Grose  conducted  a study  to  determine  which  numerical 
integration  technique  would  minimize  the  unstable  and  stiff 
behavior  associated  with  a chemically  reacting  system.  For 
his  analysis,  he  selected  the  fourth  order  Runge-Kutta, 
Adams-Moulton,  and  Treanor methods.  The  Treanor  method  was 
chosen  because  of  its  significant  reductions  in  computational 
times,  its  ability  to  efficiently  handle  stiff  systems,  and 
automatically  alter  step  size.  This  latter  feature  reduced 
the  chance  of  divergence  through  a series  of  internal  checks. 
As  the  flow  approached  chemical  equilibrium,  this  method 
automatically  increased  the  integration  step  size  in  order  to 
increase  the  rate  of  convergence  and  reduce  the  necessary 
computational  time.  The  Treanor  integration  formula  is  based 
upon  approximating  ^ = f(x,y)  and  is  comprised  of  the 
following  expression. 
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- fi  [f1F1  + [ -3(fx  + Py1)  + 2(f2  + py2)  + 2(f3  + Py3) 
- (f4  + Py4)  ] F2  + 4 [ (fx  + Py1)  - (f2  + Py 2 ) 

- (f3  + py3)  + (f4  + py4)  ] f3  } (59) 


where  h is  the  Ax  interval  of  integration  and  the  functions 

F and  related  constants  are  defined  by 
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y i = y 
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X„  = X 
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- xx  + h/2  , y2  = yi  + (h/2)f1 

' y3  = yi  + (5/2)f2 

/ y4  = yx  + (h)f3 
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(64) 


It  should  be  noted  that  as  P approaches  zero,  equation  (59) 
reduces  to  the  fourth  order  Runge-Kutta  method. 

The  integration  step  is  then  accomplished  in  the 
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following  manner.  First,  an  initial  integration  is  performed 
in  accordance  with  a preselected  delta-x  value.  This 
integration  step  corresponds  to  a new  point  on  the  chosen 
streamline  at  which  the  new  streamline  point  is  at  the  new  x 
value  and  along  a y coordinate  perpendicular  to  the  shock 
front.  The  values  of  pressure  and  pressure  gradient  are  then 
determined  for  that  point,  and  at  the  midpoint  of  the 
interval,  through  the  use  of  interpolation.  The  value  of 
internal  energy  is  then  evaluated,  using  an  initial  estimate 
for  translational  temperature  and  interpolated  pressure,  at 
the  initial  point  of  the  interval  by  a Newton  iterative 
procedure.  After  convergence,  the  partial  derivatives 
associated  with  species  concentrations,  vibrational  energy, 
and  enthalpy  are  evaluated  at  the  start  of  the  integration 
interval.  This  procedure,  starting  with  the  pressure 
interpolation,  is  then  repeated  twice  at  the  middle  and  once 
st  the  end  of  the  interval,  as  part  of  a fourth  order 
Runge-Kutta  technique,  in  order  to  obtain  the  necessary 
coefficients  used  in  the  Treanor  numerical  integration 
algorithm  . These  coefficients  reach  their  final  values 
after  the  prescribed  integration  step  has  passed  through  a 
series  of  internal  checks.  If  for  any  reason  the  step  has 
produced  an  invalid  result,  such  as  a negative  species 
concentration,  the  step  size  is  reduced  and  the  procedure  is 
then  repeated.  After  a successful  completion  of  a step,  the 
flowfield  values  are  updated  at  the  new  point,  whereby  the 
vibrational  temperature  is  computed  for  all  diatomic  species 
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based  on  their  current  values  of  vibrational  energy.  The 
overall  procedure  is  repeated  until  each  streamline  has  been 
integrated  to  an  x-value  which  corresponds  to  the  preselected 
maximum  z-value. 

While  the  above  paragraph  describes  the  method  of 
solution  for  the  entire  flowfield,  a special  problem  occurs 
when  the  chemical  and  thermodynamic  quantities  are  initially 
evaluated  for  the  body  streamline  (\p  = 0)  . The  problem  takes 
place  since  x and  \p  both  approach  zero  near  the  z-axis  and 
cause  the  equations  to  become  ill-behaved.  The  body- 

streamline  integration  is  accomplished  by  dividing  the 
initial  delta-x  step,  within  the  stagnation  region,  into  a 
set  of  subintervals.  Each  subinterval  streamline  is 
integrated  in  accordance  with  the  flowfield  algorithm  until 
the  x value  is  equal  to  the  initial  delta-x  value.  At  which 
point,  all  the  thermodynamic  and  chemical  quantities  are 
stored.  Final  evaluation  for  the  body  point  is  accomplished 
by  the  extrapolation  of  all  stored  quantities  to  the  \)i  = o 
body  point.  The  normal  algorithm  then  proceeds  from  there 
using  the  extrapolated  quantities  for  initial  values. 

The  final  step  in  the  solution  procedure  • is  the 
determination  of  the  physical  space  coordinates  for  the  body 
and  flowfield  streamlines.  These  coordinates  are  obtained  by 
integrating  equation  (42)  from  the  given  streamline  to  the 
shock  using  interpolated  delta— psi  and  (1/pu)  values  along 
lines  of  constant  x.  The  flow  chart  for  the  complete  solution 
algorithm  is  depicted  in  Figure  4. 
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INTERNAL  ENERGY  MODEL 


Since  the  AOTV  flowfield  is  assumed  to  be  composed  of 
perfect  gases,  which  implies  that  the  intermolecular  forces 
surrounding  a particle  are  negligible,  the  molecular  activity 
within  the  system  can  be  represented  as  a series  of  elastic 
particle  collisions.  Further,  the  assumption  that  the 
collisional  • activity  at  sufficiently  high  temperatures 
distributes  the  particles  over  a wide  range  of  permissible 
energy  states,  is  the  basic  foundation  of  a reacting  gas 
model.  This  distribution  is  referred  to  as  a Boltzmann 
distribution,  and  it  allows  the  energy  states  within  a given 
system  to  be  represented  in  terms  of  partition  functions 
which  depict  how  the  particles  are  distributed  or  partitioned 
among  the  various  energy  states.  It  is  convienent  to  express 
these  partition  functions  in  terms  of  energy  levels  instead 
of  energy  states.  An  energy  level  is  defined  as  consisting  of 
all  energy  states  having  identical  values  of  energy.  A level 
containing  more  than  one  state  is  defined  as  a degenerate 
level.  The  internal  energy  within  a given  set  of  levels  can 
also  be  subdivided  into  its  modes  of  motion  using  partition 
functions.  These  modes  can  include  contributions  from 
translation,  rotation,  vibration,  and  electronic  excitation. 
Thus,  the  internal  energy  can  be  represented  as  a summation 
of  each  molecular  mode  over  a range  of  energy  states  and  the 
internal  energy  for  the  ith  species  is 
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(65) 


where  the  last  term,  the  standard  heat  of  formation,  is 

included  in  order  to  reference  all  species  to  a common  state. 

The  internal  energy  per  unit  mass,  as  derived  from 

17 

statistical  thermodynamics  , can  be  expressed  as 


RT2  f a (In  Q)  I 

M I ST 
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(66) 


where  the  partition  functions  for  the  translational, 
rotational,  vibrational,  and  electronic  modes  are 


*trans . 


- v*  ( 


27rmkT  )3/2 


> '2 

ii 


J 


rot. 


87r2IkT 

C2 

<r™h 

m 


^vib. 


1 - e<"W 


^elec 


= Y g .f-i 
•-  tk 


,/T) 


(67) 

(68) 

(69) 

(70) 


where  k is  the  Boltzmann  constant,  m is  the  mass  of  the 
molecule,  is  the  specific  volume  and  h is  Planck’s 

constant.  In  addition,  I represents  the  molecular  moment  of 
inertia,  <r  is  a symmetry  factor,  and  g.  is  the  degeneracy 

xii  v 
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factor  of  energy  level  t. 

The  substitution  of  these  molecular  partition  functions 
into  equation  (66)  yields  the  following  expressions 


The  total  internal  energy  at  a given  point  is  then  obtained 
by  substituting  equation  (65)  into  equation  (50) . 
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RESULTS  AND  DISCUSSION 

For  this  discussion,  the  basic  AOTV  mission  profile  has 
been  divided  into  three  areas  of  interest,  which  are  referred 
to  as  the  entry,  max-Q,  and  exit  trajectory  points.  The 
values  of  freestream  pressure,  temperature,  and  velocity  for 
each  point  are  displayed  in  Table  1.  A flowfield  analysis  at 
each  point  has  been  made  with  each  vibration-dissociation 
coupling  model  using  three  specific  reaction  chemistry  sets. 
This  analysis,  which  consisted  of  forty  five  separate 
computations,  has  been  followed  by  a comparison  study  of  all 
vibration-dissociation  coupling  models.  The  study  has  been 
further  discretized  into  an  analysis  of  the  three  chemical 
reaction  rate  sets  at  each  trajectory  point  for  individual 
vibration-dissociation  coupling  models.  The  chemical  reaction 
systems  and  their  respective  rate  coefficients  are  depicted 
in  Tables  2,  3,  and  4. 

The  comparative  studies  have  been  conducted  in  order  to 
determine  which  combination  of  species,  reaction  rates,  and 
vibration  coupling  models  is  most  representative  of  the  AOTV 
flowfield  as  well  as  having  the  additional  advantage  of 
computational  efficiency.  For  completeness,  vibrational 
equilibrium  results  have  been  included  for  discussion 
purposes  even  though  they  were  not  part  of  the  actual 
comparative  study.  In  addition,  all  shock  jump  conditions 
have  been  based  on  the  assumption  that  the  species 

qv 
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Table  1.  AOTV  Trajectory  Points 

Point 

2 

Press. (dynes/cm  ) 

Temp.  (K) 

Vel . (cm/sec) 

Entry 

10.35 

180.65 

1000000 

Max  Q 

15.715 

197.101 

891500 

Exit 

10.35 

180.65 

771000 

Table  2 . 

Reaction  Rate 

Set  1 

(RR1) 

Reaction 

* 

A 

B 

E 

Dir. 

N2  + M 

<=> 

2N  + M 

5.0E+19 

-1.5 

0.0 

kb 

02  + M 

20  + M 

1.19E+21 

-1.5 

59380 

kf 

NO  + M 

<=> 

N + 0 + M 

5.18E+21 

-1.5 

75490 

kf 

N + 02 

NO  + 0 

1. OE+12 

0.5 

3120 

kf 

O + N2 

<=> 

NO  + N 

5.0E+13 

0.0 

38016 

kf 

N + O 

NO+  + e“ 

1.8E+21 

-1.5 

0.0 

kb 

Table  3. 

Reaction  Rate 

Set  2 

(RR2 ) 

Reaction 

A 

B 

E 

Dir. 

All  of 

RR1 

N + N 

N2  + 

e 

1.40E+13 

0.0 

67800 

■ kf 

0 + M 

<==> 

0+  + 

e-"  + 

M 

2.77E+12 

0.5 

157800 

kf 

N + N+ 

2N++ 

e 

2.34E+11 

0.5 

120000 

kf 

N + N 

N+  + 

e~  + 

N 

2. 34E+11 

0.5 

120000 

kf 

N + e- 

<=> 

N+  + 

2e“ 

4.16E+13 

in 

• 

o 

120000 

kf 

<a 


Table  4.  Reaction  Rate  Set  3 (RR3) 


Reaction 

A 

B 

E 

Dir. 

All 

of 

RRl 

N + 

N 

A 

+ 

e 

1.40E+13 

o 

• 

o 

67800 

kf 

0 + 

M 

0+ 

+ 

e + 

M 

2.77E+12 

0.5 

157800 

kf 

N + 

N+ 

2N++ 

e 

2.34E+11 

0.5 

120000 

kf 

N + 

N 

N+ 

+ 

e + 

N 

2.34E+11 

0.5 

120000 

kf 

N + 

e- 

<=> 

N+ 

+ 

2e“ 

1.10E+32 

-3.14 

169000 

■ kf 
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concentrations  remained  constant  across  the  shock.  This 
assumption  is  referred  to  as  "frozen  flow",  and  these  frozen 
concentrations  were  used  as  starting  conditions  for  each 
streamline  calculation. 

Since  each  of  the  forty  five  analyses  involved  23 
streamlines,  only  a small  portion  of  the  results  can  be 
represented.  Specifically,  the  present  discussion  will 
concern  only  the  streamline  which  crossed  the  shock  front  1.5 
cm.  above  the  centerline.  In  addition,  the  mathematical 
function  of 

f 2 1 1/2 

rs  = { 2 r Zs  - Bs  Zs2  | (75) 

where  r = 23  0 and  Bg  = —4,  has  been  used  to  represent  the 
shock  shape  in  order  to  obtain  a 60  degree  blunt  cone  as  seen 
in  Figure  1(a) . 

Reaction  Rate  Set  1. 

Reaction  rate  set  1 (RRl) ^ has  been  used  as  the  primary 
air  model  for  describing  the  processes  of  dissociation  within 
the  AOTV  flowfield.  The  (RRl)  set  contains  seven  species  and 
six  reactions  with  (M)  being  the  symbol  for  an  arbitrary 
collision  partner.  For  (RRl),  the  fourth  reaction  ( o + ,N2 
NO  + N)  has  been  considered  to  be  the  primary  dissociating 
reaction  for  this  mission  profile.  In  addition,  the 
ionization  effects  have  been  taken  into  account  with  the 
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inclusion  of  the  sixth  reaction  (N  + 0 «-♦  NO+  + e ) . Since  it 
is  known  from  previous  studies  that  ionization  cannot  be 
modeled  entirely  by  one  simple  reaction  for  this  type  of 
flowfield,  the  main  theme  behind  this  reaction  rate  set  has 
been  to  compare  its  results  with  the  larger  sets  of  reactions 
in  order  to  possibly  justify  a savings  in  computational 
effort.  The  reaction  rate  coefficients  on  Tables  2-4  are  of 
the  Arrhenius  form  [k  = A T®  e^  , and  it  should  be  noted 
that  many  of  these  coefficients  were  determined  at 
temperatures  lower  than  those  which  would  exist  in  the  AOTV 
shock  layer.  Nevertheless,  it  has  been  assumed  that  these 
coefficients  are  still  reasonably  accurate  when  used  at 
higher  temperatures. 

The  concentration  and  temperature  profiles  for 
vibrational  equilibrium,  CVD,  CVDV,  CVDV-Preferential , and 
the  Park-Like  models  are  displayed  in  Figures  5-9  at  the 
entry  point  of  10  km/sec.  In  addition,  comparision  plots  of 
the  various  vibrational  coupling  models  for  single  flowfield 
variables  are  displayed  in  Figures  10-13. 

For  the  vibrational  equilibrium  case,  the  vibrational 
energy  component,  used  to  compute  the  translational 
temperature  across  the  shock,  has  been  assumed  to  be  equal  to 
the  translational  energy  mode.  This  assumption  produces  an 
instantaneous  equilibration  of  translational  and  vibrational 
temperatures  which  in  turn  produces  a higher  rate  of 
dissociation  for  various  species  due  to  an  increase  in 
vibrational  energy.  This  trend  can  be  seen  in  the  N2,  02,  and 
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NO  concentration  profiles  when  they  are  compared  against  the 
results  obtained  from  the  various  vibrational  coupling 
models.  In  addition,  the  concentrations  of  N,  N0+,  and  e 
predicted  by  the  vibrational  equilibrium  model  were  very 
similar  to  those  predicted  by  the  other  models. 

As  shown  in  Figure  6 (b) , the  CVD  model  predicts  that  the 
N2  vibrational  temperature  overshoots  the  translational 
temperature  near  the  shock  front.  This  phenomenon  is  a 
classic  example  of  the  consequences  of  not  including  the 
effects  that  dissociation  and  recombination  have  on  the 
vibrational  energy  in  a vibration-dissociation  model.  By 
examining  Figure  10(b),  it  can  be  seen  that  the  vibrational 
temperature  of  N2  for  CVD  is  higher  than  in  the  other  models. 
The  additional  vibrational  energy  within  the  physical  system 
tends  to  enhance  the  dissociation  of  the  diatomic  species  and 
causes  a more  rapid  increase  in  monatomic  concentrations  as 
compared  to  the  other  models.  These  trends  can  be  seen  in 
Figures  10(a)  and  11(a). 

On  Figure  7 (b)  , it  can  be  seen  that  the  CVDV  model 
predicts  a lower  N2  vibrational  temperature  profile  than  the 
translational  temperature  because  it  includes  the  changes  in 
vibrational  energy  due  to  the  effects  of  dissociation  and 
recombination.  These  additional  effects  not  only  change  the 
N2  vibrational  temperature  profile,  as  seen  in  Figure  10(b), 
but  also  decrease  the  N2  and  02  dissociation  rates  [Figures 
10(a),  11(b)].  This  decrease  in  N2  and  02  dissociation  delays 

the  production  of  N [Figure  11(a)],  but  shows  little  effect 
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on  the  concentrations  of  the  remaining  species.  From  these 
it  can  be  concluded  that  the  changes  in  concentration 
and  temperature  along  a streamline  are,  for  the  (RR1)  system, 
directly  tied  and  sensitive  to  the  N2  vibrational  energy  and 
the  vibration-dissociation  coupling  model. 

Since  the  CVDV-Preferential  model  only  allows  the  upper 

vibrational  energy  levels  to  easily  dissociate,  and  since 

these  levels  are  less  populated  than  the  lower  ones,  it 

P^’e<^icts  a rate  of  dissociation  even  slower  than  the 

aforementioned  models.  This  preferential  coupling  effect 

along  with  the  corresponding  decrease  in  N2  dissociation,  and 

the  subsequent  decrease  in  N production  is  very  apparent  on 

Figures  10(a),  11(a),  and  11(b).  The  CVDV-Preferential  model 

also  displays  a subsequent  increase  in  the  NO+  and  electron 

concentrations  when  compared  to  the  CVD  and  CVDV  models.  This 

increase  is  depicted  in  Figures  13 (a)  and  13 (b) . 

results  using  the  Park— Like  model  (Figure  9)  show 

some  interesting  and  significantly  different  trends  when 

compared  to  the  previously  discussed  models.  As  can  be  seen 

from  Figures  9(b)  and  10(b),  the  Park-Like  model  has  an  N2 

vibrational  temperature  profile  which  gradually  rises  to  a 

peak  value,  that  is  approximately  one  third  of  the 

translational  shock  jump  temperature,  followed  by  a slow 

decrease  to  a constant  or  pseudo-equilibrium  value.  In 

addition,  as  shown  on  the  concentration  plots,  the  Park-Like 

model  closely  follows  the  concentration  profiles  associated 

wiPh  the  CVDV— Preferential  model  for  most  of  the  species  in 
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question.  The  only  species  component  which  shows 

non-preferential  treatment  near  the  shock  front  is  c>2 ; but, 
as  depicted  in  Figure  11(b),  it  equilibrates  with  the 
CVDV-Preferential  model  for  the  latter  two  thirds  of  the 

streamline.  This  correspondence  is  an  unexpected  result 

considering  that  the  Park-Like  model  only  modifys  the 
vibration-dissociation  interaction.  Apparently,  the  modified 
Landau-Teller  term,  coupled  with  the  additional  CVDV  terms, 
provides  an  additional  mechanism  similar  to  preferential 
control . 

The  final  area  of  discussion  for  this  trajectory  point 
and  reaction  rate  set  is  the  geometric  orientation  of  the 

shock,  streamline,  and  body  coordinates.  These  coordinates 
are  depicted  in  Figure  14  for  each  vibration-dissociation 
coupling  model.  All  of  the  vibrational  coupling  models 
basically  show  the  same  body  shape  and  streamline 
orientation.  As  can  be  seen  from  Figure  14,  the  Maslen  method 
breaks  down  near  the  stagnation  region  in  its  prediction  of 
the  body  shape.  This  failure  is  due  to  the  fact  that  the 
method  assumes  a small  change  in  v— velocity  with  respect  to 
x,  which  of  course  breaks  down  in  the  stagnation  region. 

Nevertheless,  the  results  for  the  streamline  depicted  in 
Figure  14  are  valid.  Another  noticeable  trend  in  the  figure 
is  the  change  in  shock  standoff  distance  between  models, 
which  shows  that  as  dissociation  processes  are  reduced,  the 
shock  standoff  .distance  increases.  This  trend  makes  sense 
because  as  the  dissociation  processes  are  slowed  down,  the 
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translational  temperature  decreases  and  the  density  increases 
at  a slower  rate.  Therefore,  the  standoff  distance  must 
increase  in  order  to  maintain  mass  flux  conservation. 

An  analysis  of  concentration  and  temperature  profiles 
for  the  various  vibration  coupling  models  has  also  been 
conducted  at  the  max-Q  and  exit  trajectory  points. 
Interestingly,  all  aforementioned  trends  for  each  species, 
temperature,  and  vibrational  coupling  model  are  the  same.  It 
appears  that  the  trends  in  temperature  and  species 
concentration  are  relatively  independent  of  freestream 
velocity  for  this  reaction  rate  set.  In  addition,  the 
streamline  and  body  coordinates  for  both  trajectory  points 
maintained  their  orientation  and  body  shape. 

Reaction  Rate  Set  2. 

Reaction  rate  set  2 (RR2)  contains  the  primary 

dissociation  reactions  of  the  first  reaction  rate  set  plus 
additional  chemical  reactions'^ ' ^ . These  additional 
reactions  are  included  in  order  to  further  describe  the 
ionization  processes  that  take  place  within  the  shock  layer. 
The  physical  system  for  (RR2)  has  been  modeled  by  the  ten 
species  N2,  C>2,  N,  0,  NO,  N0+,  e",  N2+,  N+,  and  0+.  In  this 
set,  the  nitrogen  ionization  reaction  rate  coefficients^  are 
based  on  experimental  data  and  assume  that  the  ionization 
proceeds  from  the  initial  N ground  state  to  the  intermediate 

4 

3s  P excited  state  followed  by  rapid  ionization.  It  is.  also 
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assumed  that  the  five  additional  reaction  rate  coefficients 
are  reasonably  accurate  when  extrapolated  to  temperatures 
beyond  their  experimental  range.  In  addition,  for  the 
electron  impact  reaction  (N  + e~  <=»  N+  + 2e”)  , the  rate 
coefficient  is  assumed  to  be  governed  by  electron  temperature 
instead  of  heavy  particle  or  translational  temperature.  In 
this  program,  this  reaction  is  actually  controlled  by  the  N2 
vibrational  temperature  since  the  electron  temperature  has 
been  modeled  by  Tvn2  in  the  present  study. 

The  concentration  and  temperature  profiles  for  each 
vibration  coupling  model  are  plotted  and  displayed  at  the 
entry  trajectory  point  in  Figures  15-19.  In  addition,  a 
comparative  study  has  again  been  made  ■ concerning  the 
vibration  coupling  model  effects  on  vibrational  temperature 
and  species  concentrations  as  depicted  in  Figures  20-25. 

As  can  be  seen  in  Figure  15,  the  vibrational  equilibrium 
case  exhibits  a temperature  profile  similar  to  that  seen  with 
the  first  reaction  rate  set.  Since  the  first  reaction  rate 
set  contains  only  one  ionization  reaction,  the  NO+  and  e” 
concentrations  are  always  in  equilibrium  with  each  other  due 
to  the  conservation  of  mass.  The  additional  ionization 
reactions  in  (RR2) , however,  produce  an  increase  in  the 
amount  of  electrons,  which  leads  to  considerable  changes  in 
the  ion  species  concentrations. 

Figure  16  shows  that,  for  this  reaction  set,  the  CVD 

model  exhibits  an  N2  vibrational  temperature  overshoot  of  the 

translational  temperature,  which  is  similar  to  the  improper 
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behavior  observed  with  the  previous  reaction  rate  set.  Also, 
the  predicted  initial  electron  production  for  the  CVD  model 
is  slightly  greater  than  that  of  the  vibrational  equilibrium 
case.  But  as  seen  in  Figure  23(a),  the  electron  concentration 
is  significantly  greater  than  that  predicted  by  the  other 
vibrational  coupling  models.  Furthermore,  it  can  be  seen  from 
the  model  comparison  plots  that  the  CVD  model  predicts  a 
greater  concentration  of  N+  ions  and  a subsequent  decrease  in 
other  ion  formations  as  compared  to  the  aforementioned 
models . 

The  CVDV  model  results,  which  are  plotted  on  Figure  17, 
display  a rapid  increase  in  N2  vibrational  temperature  near 
the  shock  front  followed  by  a gradual  decrease  that  parallels 
the  translational  temperature.  This  vibrational  temperature 
profile  exhibits  the  same  trend  as  predicted  by  the  previous 
reaction  rate  model.  Interestingly,  the  CVDV  model  displays  a 
significant  decrease  in  electron  production  as  compared  to 
the  CVD  model  (Figure  23)  . This  decrease  in  electron 
production  is  accompanied  by  a corresponding  decrease  in  the 
N concentration  and  an  increase  in  the  NO  , N2  , and  0 
concentrations.  Considering  that  the  atomic  nitrogen 
concentration  prediction  from  the  CVDV  model  is  higher  than 
the  CVD  prediction,  as  shown  in  Figure  21(a),  these  charged 
species  results  are  somewhat  surprising.  These  trends 
indicate  a significant  interaction  between  vibration- 
dissociation  coupling  processes  and  the  ionization  reactions. 

For  the  CVDV-Preferential  model,  the  temperature  profile 
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of  Figure  17 (b)  shows  a similar  pattern  to  that  predicted  by 
the  first  reaction  rate  model.  The  electron  production  is 
slightly  greater  than  that  of  the  CVDV  model  for  the  same 
reaction  rate  model;  and  therefore,  the  preferential  results 
also  depicts  similar  changes  in  ion  concentration.  As 
expected,  with  the  exception  of  the  02  species,  the  rates  of 
dissociation  are  slightly  slower  than  that  predicted  by  the 
CVDV  model.  The  02  species  displays  significant  reductions  in 
initial  dissociation  due  to  preferential  treatment  and 
control. 

The  temperature  and  concentration  results  from  the 
Park-Like  model  are  shown  in  Figure  19  are  similar  to  those 
obtained  by  the  first  reaction  rate  model.  Again,  as  shown  in 
Figures  20-22,  the  dissociation  process  and  concentration 
profiles  for  the  non-ionized  species  closely  follow  the 
concentrations  predicted  by  the  CVDV-Pref erential  model. 
However,  the  ionization  profiles  on  Figures  23-25  are 
different  than  those  obtained  with  the  CVD,  CVDV,  and 
CVDV-Pref erential  models.  Since  the  electron  impact  reaction 
rate  (N  + e «=*•  N+  + 2e”)  is  controlled  by  Tvn2 , which  is 
shown  as  being  lower  for  the  Park-Like  model  [Figure-  20(b)], 
the  production  of  N+  is  significantly  reduced.  This  reduction 
in  the  amount  of  N+  is  accompanied  by  subsequent  increases  in 
N2+,  NO+,  and  0+  when  compared  to  the  other  vibrational 
coupling  models.  Surprisingly,  the  increase  in  the  electron 
production  rate  is  significant  enough  to  allow  a greater  mole 
fraction  concentration  of  0+  over  that  of  N+.  The  Park-Like 
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model  is  the  only  model  to  display  this  characteristic  for 
this  trajectory  point. 

For  this  trajectory  point  and  reaction  rate  set,  the 
shock,  streamline,  and  body  coordinates,  which  are  shown  on 
Figure  26,  display  the  expected  changes  in  shock  standoff 
distance  due  to  vibration-dissociation  coupling  model 
differences.  In  addition  differences  become  apparent,  when 
comparing  (RR1)  to  (RR2) , with  the  same  vibrational  coupling 
model.  The  standoff  distances  for  (RR2)  are  actually  less  for 
each  model  even  though  the  trends  between  the  models  remain 
the  same.  Apparently,  the  additional  species  and  ionization 
reactions  of  (RR2)  increase  the  amount  of  ionization,  and 
decrease  the  temperature,  which  in  turn  leads  to  an  increase 
in  density  and  a shorter  standoff  distance. 

Results  have  also  been  obtained  with  this  reaction  rate 
model  at  the  max-Q  and  exit  trajectory  points.  While  the 
aforementioned  temperature,  dissociation,  and  ionization 
trends  remained  the  same  for  both  points,  the  results  did,  of 
course,  show  a reduction  in  temperature  and  production  rates 
associated  with  the  reductions  in  freestream  velocity.  The 
only  distinguishable  trend  that  was  different  from  the  entry 
trajectory  point  was  a greater  concentration  of  0+  over  that 
of  N+  for  all  vibrational  coupling  models.  This  trend  was 
coupled  to  an  order  of  magnitude  reduction  in  electron 
concentration  and  a decrease  in  the  vibrational  temperature 
of  nitrogen.  It  would  appear  that  sufficient  magnitudes  of 
both  electron  concentration  and  N2  vibrational  temperature 


FIGURE  26.  COORDINATES,  V=10  Km/s,  RR2 
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are  necessary  conditions  for  a dominant  N+  population  to 
exist. 

Reaction  Rate  Set  3 . 

Reaction  rate  set  3 (RR3)  also  includes  ten  species  with 
the  six  primary  reactions  of  the  first  reaction  rate  set  plus 
the  five  additional  ionization  reactions.  The  five  additional 
reactions  are  the  same  as  those  described  in  the  second 
reaction  rate  set,  except  that  the  reaction  rate  coefficients 
for  the  electron  impact  reaction  have  been  changed.  While 
the  electron  impact  reaction  rate  is  still  being  controlled 
by  the  electron  temperature  (or  vibrational  temperature  of 
N2)  , it  is  based  on  a one  step  process  instead  of  a assumed 
two  step  intermediate  sequence  as  previously  discussed  with 
the  second  reaction  rate  set.  In  addition,  the  updated 
electron  impact  reaction  rate  is  considerably  faster  than  the 
previous  impact  rate.  Again,  this  reaction  rate  set  is 
assumed  to  be  reasonably  accurate  when  extrapolated  to  higher 
temperatures.  As  with  the  previous  reaction  rate  sets,  the 
results  for  the  entry  trajectory  point  are  plotted  and 
displayed  in  Figures  27-37. 

The  vibrational  equilibrium  case,  as  shown  in  Figure  27, 
depicts  a faster  rate  of  equilibration  than  the  CVD,  CVDV, 
CVDV-Preferential  and  Park-Like  models.  Also,  it  can  be  seen 
that  the  usage  of  the  faster  electron  impact  ionization  rate 
produces  a very  rapid  increase  in  electron  concentration 
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(b) 

FIGURE  30.  CVDV-P  MODEL  AT  V=10  Km/s,  RR3 


\V> 


TEMPERATURE  ( K ) *1(j»  MOLE  FRACTION 

IOO  15.0  20.0  25.0  30  0 35.0  40.0  10  * 10  * 10"*  10*  1 


9 


3.0  6.0  9.0  12.0 

DISTANCE  ALONG  STREAMLINE  ( Cm  ) 


15.0 


FIGURE  37.  0+  PROFILE  AT  V=10  Km/s,  RR3 


86 


immediately  near  the  shock  front.  This  ionization,  in  the 
vicinity  of  the  shock  front,  is  rapid  enough  to  temporarily 
deplete  the  amount  of  nitrogen  and  reduce  the  N2+  and  N0+ 
concentrations  several  orders  of  magnitude.  However,  as  the 
streamline  distance  increases,  the  ionization  of  N stabilizes 
enough  to  allow  an  increase  in  the  concentrations  of  N,  N2+, 

and  N0+.  This  phenomenon  of  electron  avalanche  is  the 

dominant  feature  in  the  (RR3)  results  and  is  responsible  for 
many  unusual  trends  in  the  species  profiles. 

The  CVD  model,  portrayed  in  Figure  28,  shows  a rapid 
decrease  in  translational  temperature  near  the  shock  front. 
In  addition,  the  N2  vibrational  temperature  overshoot  is  far 
more  extensive  than  previous  CVD  model  results,  which 

intuitively  seems  incorrect.  This  increase  in  vibrational 
temperature,  coupled  with  the  electron  avalanche  . effect, 
produces  abrupt  changes  in  N2+  and  NO+  productions.  These 

rapid  changes  indicate  early  electron  recombinations  of  n2+ 
and  N0+  into  atomic  nitrogen"  and  oxygen.  This  early 
recombination  is  followed  by  a short  period  of  rapid  ion 
formation,  and  then,  by  a gradual  approach  to  equilibrium. 
This  type  of  abrupt  change,  due  to  forward  and  reverse 
processes,  can  also  seen  to'  a lesser  degree  in  the 
concentration  profile  of  NO. 

The  CVDV  model  results,  which  are  shown  in  Figure  29, 

depict  a rapid  dedrease  in  translational  temperature  due 
to  the  increase  in  electron  production  as  previously 
discussed  for  the  vibrational  equilibrium  and  CVD  models. 
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As  expected,  the  translational-vibrational  temperature 
equilibration  rate  is  slower  than  that  of  the  CVD  model.  The 
CVDV  model  also  displays  an  uncharacteristic  N2  vibrational 
temperature  overshoot  which,  in  itself,  indicates  the 
magnitude  of  the  electron  avalanche  effect  and  the  subsequent 
cooling  effect  on  the  translational  temperature.  The 
concentration  profiles  for  N2+  and  N0+  display  the  same 
changes  due  to  ionization  as  observed  for  the  CVD  model.  As 
shown  in  Figure  33(a),  the  rapid  N+  production  rate  again 
produces  a depletion  of  N followed  by  a slower  approach 
towards  equilibrium  as  compared  to  CVD.  This  slower  N 
production  rate,  coupled  with  a significant  decrease  in  C>2 
dissociation,  lowers  the  peak  NO  concentration  and  leads  to 
the  smooth  transition  shown  in  Figure  34(a). 

The  CVDV-Preferential  model  (Figure  30)  displays  a 
<^ac-:^eas®  in  the  dissociation  rates  of  N2  and  02  as  compared 
to  the  CVDV  model  and  are  shown  in  Figures  32(a)  and  33(b). 
Also,  the  concentration  profile  for  the  electrons  [Figure 
35 (a)]  shows  a slight  decrease  in  the  initial  rate  of 
ionization  due  to  electron  avalanche,  when  compared  to  CVD 
and  CVDV.  Finally,  the  CVDV-Preferential  temperature 
Pr°£iles#  which  are  shown  in  Figure  30(b) , do  not  depict  any 
^2  vibrational  temperature  overshoot  of  the  translational 
temperature  as  was  seen  previously  in  the  CVD  and  CVDV 
models. 

As  portrayed  in  Figure  31(b),  the  Park-Like  model 
temperature  profiles  are  similar  to  those  obtained  with  the 
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other  reaction  rate  models,  but  different  than  those  obtained 
with  the  other  vibration  models.  The  modified  Landau-Teller 
term  within  the  vibrational  rate  equation  prevents  the  N2 
vibrational  temperature  overshoot  of  the  translational 
temperature,  and  lowers  the  peak  vibrational  temperature. 
Nevertheless,  Figure  32(b)  shows  that  along  much  of  the 
streamline,  the  various  coupling  models  closely  predict  the 
vibrational  temperature  of  N2*  As  can  be  seen  from  the  e”  and 
N+  comparison  profiles  [Figures  35(a)  and  36(a)],  this 
decrease  in  peak  N2  vibrational  temperature  significantly 
decreases  the  electron  avalanche  effect  due  to  its  coupled 
Tvn2  rate  controlling  temperature.  This  delay  in  electron 
production  prevents  early  deionization  of  ionized  species 
near  the  shock  front,  also  appears  in  the  results  for  the 
other  vibrational  coupling  models.  Accordingly,  the  N2  + and 
N0+  species  profiles  display  a smooth  overshoot  in 

concentrations  near  the  shock  front.  The  Park-Like  model, 
with  this  reaction  rate  set,  ' also  predicts  a greater 

concentration  of  N+  over  that  of  0+.  The  aforementioned  trend 
is  uncharacteristic  for  this  vibrational  coupling  model  at 
this  trajectory  point.  Finally,  it  should  be  noted  that  the 
concentration  profiles  of  the  Park-Like  model  do  not  follow 
the  profiles  associated  with  the  CVDV-Preferential  model. 
Apparently,  the  introduction  of  the  rapid  Kang  and  Dunn 
electron  impact  ionization  rate,  under  N2  vibrational 
temperature  control,  is  the  major  reason  for  these 

differences  in  concentration  profiles. 
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The  shock,  streamline,  and  body  coordinates  for  this 
reaction  rate  set  are  displayed  in  Figure  38.  All  physical 
space  coordinates  maintained  their  basic  shape  and 
orientation  when  compared  to  the  previous  reaction  rate  model 
results.  However,  the  CVD,  CVDV,  and  CVDV-Preferential 
coupling  models  show  significant  changes  in  shock  standoff 
distance.  The  standoff  distance  for  (RR3)  is  actually  20  to 
3 0 percent  less  for  each  model,  except  for  the  Park-Like 
model,  which  showed  little  change  in  standoff  distance.  The 
decrease  in  shock  standoff  distance  is  concurrent  with  the 
abrupt  decrease  in  the  translational  temperature  due  to  the 

rapid  ionization  as  predicted  by  the  CVD,  CVDV,  and  CVDV- 

% 

Preferential  models.  Due  to  this  decrease  in  translational 
temperature,  the  density  is  higher  and  the  detachment 
distance  is  smaller.  On  the  other  hand,  for  the  Park-Like 
model,  the  translational  temperature  is  higher  along  much  of 
the  streamline  with  a cooresponding  lower  density  and  higher 
shock  standoff  distance. 

At  the  max-Q  and  exit  trajectory  points,  temperature  and 
concentration  profiles  have  also  been  generated  and  studied 
for  any  significant  trends.  The  results  at  the  max-Q  point 
show  similar  trends  when  compared  to  the  results  at  the  entry 
trajectory  point.  At  the  exit  point,  the  most  significant 
changes  are  the  lack  of  a N2  vibrational  temperature 
overshoot  for  the  CVDV  model,  and  a greater  concentration  of 

4. 

0 over  that  of  N for  the  Park-Like  model. 
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Reaction  Rate  Studies. 


Although  there  has  been  previous  discussion  and 

comparisons  of  the  effects  of  the  reaction  rate  and 

vibrational  coupling  models,  a detailed  analysis  has  been 

performed  on  all  reaction  rate  sets  based  on  a single 
vibrational  coupling  model  and  trajectory  point.  However, 

this  analysis  has  been  limited  to  the  CVDV  and  Park-Like 
models  at  all  trajectory  points  in  which  only  the  significant 
trends  will  be  discussed  in  interest  of  practicality. 

The  results  for  the  CVDV  model,  at  the  entry  trajectory 
point,  are  displayed  in  Figures  39-44.  The  changes  in  N2 
vibrational  temperature  [Figure  39(b)]  depict  that  the  first 
and  second  reaction  rate  models  predict  similar  profiles  but 
that  the  third  model  yields  significantly  lower  vibrational 
and,  in  turn,  electron  temperatures.  The  influence  of  the 
additional  ionized  species  and  reactions  are  shown  to  be 
significant,  in  that  the  first  and  second  sets  display  an 
order  of  magnitude  difference  in  electron  concentrations 
[Figure  42(a)],  Likewise,  the  influence  of  the  electron 
impact  ionization  effect  is  also  displayed  by  the  (RR3) 
results  for  all  concentration  and  temperature  profiles. 
Surprisingly,  the  increase  in  ionization  associated  with  the 
(RR3)  electron  impact  reaction  reduces  the  overall  N2  and  02 
dissociation  rate  while  leading  to  an  increase  in  the  amount 
of  NO  concentration.  This  is  possibly  due  to  the  immediate 
ionization  of  N and  deionization  of  N2  + , N0+,  and  o"r.  The 
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FIGURE  44.  0+  PROFILE  AT  V=10  Km/s,  CVDV 
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results  for  the  max-Q  trajectory  point  displayed  similar 
profiles. 

The  exit  point  comparison  results  for  the  CVDV  model  are 
shown  in  Figures  45-50,  and  demonstrate  that  the 
concentration  profiles  for  all  ionized  species  are  virtually 
identical  for  the  three  reaction  rate  model.  These  trends  are 
extremely  significant  because  they  justify  a considerable 
savings  in  computational  time  by  using  the  smaller  reaction 
rate  model  while  still  maintaining  engineering  accuracy. 

Comparison  temperature  and  concentration  profiles  have 
also  been  generated  using  the  Park-Like  model  and  all 
reaction  rate  sets.  The  Park-Like  model  results  predict 
similar  trends  to  the  CVDV  model  for  all  three  trajectory 
points.  However,  the  • Park-Like  model  displays  better 
agreement  between  all  reaction  rate  sets  over  a wider 
velocity  range  when  compared  to  the  CVDV  model.  Possibly,  the 
use  of  the  Park-Like  model  could  justify  the  use  of  the 
smaller  reaction  rate  set,  at  the  higher  velocities,  in  order 
to  take  advantage  of  reduced  computational  intensity.  Of 
course,  the  larger  reaction  rate  sets  would  have  to  be  used 
in  order  to  provide  a more  accurate  analysis  of  the 
ionization  processes. 
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CONCLUSIONS 


The  comparative  study  of  reaction  rates,  species,  and 
vibrational  coupling  models  was  a culmination  of  forty  five 
computer  runs.  Only  the  profiles  of  physical  significance 
were  chosen  and  discussed  for  this  thesis. 

After  much  evaluation  and  discussion,  the  following 
conclusions  were  obtained  from  this  comparative  study.  First, 
when  the  use  of  a vibrational  coupling  model  is  being 
considered,  the  coupling  effect  between  the  vibrational  mode, 
dissociation,  and  recombination  are  extremely  important. 
Therefore,  .the  results  obtained  from  the  CVD  model  are 
considered  to  be  incorrect  since  it  fails  to  incorporate 
these  effects.  Secondly,  as  can  be  seen  from  the  vibrational 
coupling  and  reaction  rate  studies,  the  substitution  of 
different  reaction  rate  coefficients  for  the  electron  impact 
rate  had  a substantial  impact  on  all  physical  profiles. 
Additional  reaction  rate  studies  are  needed  to  verify  these 
coefficients  along  with  other  possible  substitutions. 
Thirdly,  the  Park-Like  model  exhibited  preferential 
dissociation,  and  a more  accurate  representation  of  electron 
temperature  over  a wider  velocity  range  when  compared  to  the 
CVD,  CVDV , and  CVDV-Pref erential  models.  Finally,  if 

ionization  effects  are  not  considered  important,  then  the  use 
of  the  smaller  reaction  rate  set  will  predict  reasonable 
answers  with  a substantial  reduction  in  computational  time. 
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APPENDIX 


The  coupling  factor  is  derived  using  the  assumption  that 
the  vibrational  energy  levels  are  modeled  as  a system  of 
harmonic  oscillators  which  are  cutoff  just  prior  to 
dissociation.  The  partition  function  which  represents  this 
concept  is 


Q(T) 


1 - e<-VT> 
1 - e<-VT> 


(76) 


The  coupling  factor  is  defined  as  a ratio  of  the  actual  to 
the  local  vibrational  equilibrium  forward  reaction  rates.  The 
coupling  factor  can  then  be  redefined  in  the  form  of 
partition  functions  as 

k-(T,T  ) Q(T)  Q(T  ) 

4>  = — — = — (77) 

kf  (T  ) N Q (T  ) 


Substituting  equation  (76)  into  (77)  yields 


1 

1 - e(“VT>1 

1 - e<-W] 

N 

1 - e<“VT>J 

1 - e^~ev^Tm^ 

e<-Wl 

e<-VV. 


(78) 
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The  characteristic  dissociation  temperature  (0^)  is  assumed 
to  be  negligable  for  the  (-1/T)  and  (-1/T  ) terms  during 
dissociation.  Therefore  equation  (78)  is  reduced  to 


1 

1 - e<-VVl 

1 - X“VT»>1 

N 

i - e<-VT> 

J 

1 - e<-VT„>J 

(79) 


The  final  form  of  this  equation  is  obtained  by  multiplying 
the  first  factor  by  (e  ) and  the  second  factor 

by  (e^VTaV  e^v^m^)  which  yields 


1 

1 - e^W' 

e<W  - 1 1 

N 

• <W  - 1 

^ J 

e<VT>  - 1 j 

(80) 
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NOTES 


I.  All  streamline  results  are  for  the  streamline  crossing  the  shock  front  nine 
centimeters  above  the  axis  of  a blunt  body  having  a nose  radius  of  approximately 
230  cm.. 

II.  Figures  5-34  are  for  reaction  rate  system  RRi  described  in  AIAA  Paper  No. 
88-2673  in  Appendix  i. 

III.  Figures  35  - 70  are  for  reaction  rate  system  RR2  described  in  AIAA  Paper 
No.  88-2673  in  Appendix  i. 

IV.  Figures  ?i  - 106  are  for  reaction  system  RR3  described  in  AIAA  Paper  No. 
88-2673  in  Appendix  1. 

V.  Figures  107  - 125  are  comparisons  of  the  three  reaction  systems  at  three 
different  velocities,  all  with  CVDV  coupling. 

VI.  Figures  126  - 142  are  comparisons  of  the  three  reactions  systems  at  three 
differenct  velocities,  all  with  MCVDV  coupling. 

VII.  On  many  of  the  figures  the  legend  uses  the  notation  "Park-L".  This  is 
identical  to  the  notation  "MCVDV"  used  in  AIAA  Paper  88-2673. 
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FIGURES  6(a), 6(b). CVD  MODEL  AT  V=10  Km/s,  RR1 
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FIGURES  7(a).7(b).CVDV  MODEL  AT  V=10  Km/s,  RR1 
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FIGURES  8(a), 8(b). CVDV-P  MODEL  AT  V=10  Km/s,  RR1 
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FIGURES  9(a),9(b).PARK-L  MODEL  AT  V=10  Km/s,  RR1 
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FIGURES  10 (a),  10(b). PROFILES  AT  V=10  Km/s.  RR1 
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FIGURES  11(a),  11(b). PROFILES  AT  V=10  Km/s,  RR1 
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FIGURES  12(a), 12(b). PROFILES  AT  V=10  Km/s.  RR1 
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FIGURES  13(a), 13(b). PROFILES  AT  V=10  Km/s,  RR1 
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FIGURES  15(a), 15(b). VEQ  MODEL  AT  V=8.9  Km/s,  RR1 
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FIGURES  20(a), 20(b).PROFILES  AT  V=8.9  Km/s,  RR1 
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FIGURES  21  (a),2l(b). PROFILES  AT  V=8.9  Km/s,  RR1 
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FIGURES  22(a), 22(b). PROFILES  AT  V=8.9  Km/s,  RR1 
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FIGURES  24(a), 24(b), 24(c), 24(d). CO  0RD,V=8. 9 Km/s,  RR1 
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FIGURES  29(a), 29(b).PARK-L  MODEL  AT  V=7.7  Km/s,  RR1 
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FIGURES  30(a), 30(b). PROFILES  AT  V=7.7  Km/s,  RR1 
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FIGURES  37(a), 37(b). CVDV  MODEL  AT  V=10  Km/s,  RR2 
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FIGURES  39(a), 39(b).PARK-L  MODEL  AT  V=10  Km/s,  RR2 
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FIGURES  40(a),40(b). PROFILES  AT  V=10  Km/s,  RR2 
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J FIGURES  42(a), 42(b). PROFILES  AT  V=10  Km/s,  RR2 
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FIGURE  45.PR0FILE  AT  V=10  Km/s,  RR2 
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FIGURES  49(a),49(b).CVDV  MODEL  AT  V=8.9  Km/s,  RR2 
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FIGURES  54(a), 54(b). PROFILES  AT  V=8.9  Km/s,  RR2 
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FIGURES  55(a), 55(b).PROFILES  AT  V=8.9  Km/s,  RR2 
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FIGURE  57.PR0FILE  AT  V=8.9  Km/s,  RR2 
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FIGURES  68(a),68(b). PROFILES  AT  V=7.7  Km/s,  RR2 
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FIGURE  69. PROFILE  AT  V=7.7  Km/s,  RR2 
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FIGURES  71(a), 71(b).VEQ  MODEL  AT  V=10  Km/s,  RR3 
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FIGURES  72(a)  ,72(b).CVD  MODEL  AT  V=10  Km/s,  RR3 
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FIGURES  73(a), 73(b).CVDV  MODEL  AT  V=10  Km/s,  RR3 
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FIGURES  75(a), 75(b).PARK-L  MODEL  AT  V=10  Km/s,  RR3 
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FIGURES  76(a), 76(b). PROFILES  AT  V=10  Km/s,  RR3 
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ABSTRACT 


A Parametric  Study  of  Shock  Jump  Chemistry,  Electron 
Temperature,  and  Radiative  Heat  Transfer  Models 
in  Hypersonic  Flows.  (August  1988) 

Robert  Brian  Greendyke,  B.B.A. , Baylor  University 
B.S.,  Texas  A&M  University 
Chair  of  Advisory  Committee:  Dr.  Leland  A.  Carlson 

This  thesis  examines  various  engineering  models 
of  three  physically  important  aspects  of  hypersonic  flows. 
The  thesis  begins  with  the  development  of  two  computational 
models  for  simulating  the  chemical  reactions  across  a 
hypersonic  shock  wave  in  air.  In  addition,  two  methods  for 
the  computation  of  the  electron  temperature  and  four 
methods  of  modelling  the  radiative  heat  transfer  were 
incorporated  into  an  existing  modified  inviscid  flowfield 
solution  method.  In  order  to  obtain  accurate  results  from 
radiative  heat  transfer  models,  two  correction  factors  for 
local  thermodynamic  nonequilibrium  conditions  were  also 
developed.  These  three  types  of  flow  property  models  were 
subsequently  combined  with  various  chemical  reaction  rate 
and  vibration  - dissociation  coupling  models,  and 
comparative  solutions  were  obtained  for  the  flowfield 
an  aeroassisted  flight  experiment  vehicle. 
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INTRODUCTION 


Several  new  aerospace  engineering  projects  have 
brought  about  a renewed  interest  in  hypersonic  flows  in  the 
last  few  years.  The  recent  decision  by  NASA  to  build  a 
manned  space  station  has  led  to  the  need  for  a transfer 
vehicle  to  travel  back  and  forth  between  a low  earth  orbit, 
such  as  that  used  by  the  Space  Shuttle,  and  the  higher 
earth  orbit  that  would  be  occupied  by  the  Space  Station. 
Such  a vehicle  could  also  be  used  to  transport  supplies  and 
people  between  the  Moon,  or  even  Mars,  and  an  earth  orbit. 
Many  engineers  have  proposed  the  development  of  an 
aero-assisted  orbital  transfer  vehicle,  or  AOTV,  to 
accomplish  this  task.  In  order  for  the  AOTV  to  descend  to  a 
lower  orbit,  it  would  skim  through  the  outer  layers  of  the 
earth’s  atmosphere.  The  resulting  loss  in  momentum  due  to 
the  aerodynamic  drag  forces  on  the  AOTV  would  allow  it  to 
descend  to  a lower  orbit  without  the  need  to  fire  a 
retro-rocket.  Consequently,  less  fuel  would  need  to  be 
carried  onboard  the  AOTV;  and  cargo  could  be  carried  in 
place  of  the  fuel.  For  such  a vehicle  to  be  successful,  the 
need  for  fast  and  accurate  computational  design  methods  is 
critical.  The  most  difficult  problem  in  developing  these 
methods  is  the  complexity  of  modelling  the  physical 
phenomenon  present  at  the  hypersonic  speeds  used  in  the 
aerocapture  of  the  AOTV. 

An  AOTV  transferring  from  a geosynchronous  earth 
orbit  to  a low  earth  orbit  will  typically  enter  the  earth’s 
atmosphere  at  a speed  of  10  kilometers  per  second  with  a 
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maximum  dynamic  pressure  occuring  at  an  altitude  of  75  to 
80  kilometers.  There  are  three  physical  processes  that 
occur  in  this  flow  regime  that  are  unique  to  hypersonic 
flowfields.  The  first  process  is  the  dissociation  of  the 
molecular  nitrogen  and  oxygen  present  in  the  atmosphere, 
and  their  subsequent  chemical  reactions  and  recombinations 
into  new  chemical  species.  These  chemical  reactions  have  a 
strong  effect  on  the  flowfield,  and  the  most  important 
effect  is  the  influence  on  the  temperature  of  the  flow.  The 
dissociation  of  nitrogen  and  oxygen  converts  a large  amount 
of  the  translational  energy  that  the  molecules  acquire  in 
traversing  the  strong  bow  shock  wave  into  the  dissociation 
process  itself.  Since  translational  temperature  is  the 
average  energy  random  motion  of  the  atoms  and  molecules  in 
the  air,  the  net  result  is  a decrease  in  translational 
temperature  immediately  behind  the  shock  wave.  This  loss  in 
temperature  and  the  corresponding  chemical  reactions  have  a 
strong  influence  on  the  pressure  and  density  of  the  flow, 
and  consequently,  will  have  a large  impact  on  the  design  of 
an  AOTV. 

The  high  speed  and  stong  shock  wave  inherent  in 

hypersonic  flows  also  cause  thermal  nonequilibrium  to 

develop  between  the  translational,  mode  of  molecular  energy 

2nd  the  other  modes  of  energy,  which  attain  equilibrium 

with  one  another  by  collisional  processes.  Due  to  their  low 

mass,  electrons  are  inefficient  at  reaching  an  equilibrium 

with  the  local  translational,  or  heavy  particle, 

temperature  in  a collision;  and  typically,  the  electron 

temperature  (T  ),  representing  the  energy  of  both  bound  and 
© 

free  electrons,  will  be  lower  than  the  translational 
temperature  throughout  most  of  the  region  of  chemical 
nonequilibrium. 

The  third  process  unique  to  hypersonic  flows  is 
thermal  radiation.  As  bound  electrons  change  from  a higher 
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energy  state  to  a lower  energy  state,  they  emit  the  excess 
energy  in  the  form  of  line  radiation.  Free  electrons 
produced  by  ionisation  will  similarly  emit  a continuum 
radiation,  called  Brerasstrahlung,  from  the  conversion  of 
translational  energy  or  by  deionization,  and  diatomic 
molecules  emit  band  radiation  associated  with  electronic 
transitions  involving  various  vibrational  states.  In  the 
flow  regime  of  the  AOTV,  the  radiative  heat  transported  to 
the  AOTV’s  heat  shield  could  be  a significant  portion  of 
the  total  heat  transfer;  and  since  much  of  the  radiation  is 
the  result  of  electron  state  changes  and  free  electrons 
deionizing  into  band  states,  the  prediction  of  thermal 
radiation  is  highly  dependant  on  the  accurate  determination 
of  the  electron  temperature.  The  design  of  an  AOTV  heat 
shield  will,  in  turn,  be  dependant  on  the  accurate 
prediction  of  the  radiative  heat  transfer. 

Immediately  behind  a strong  bow  shock  wave,  the 
diatomic  nitrogen  and  oxygen  present  will  quickly 
dissociate.  Other  chemical  species  will  form  and  react,  but 
the  additional  chemical  reactions  will  not  occur  as 
rapidly.  Current  computational  methods  of  calculating 
chemical  nonequilibrium  require  small  computational  steps 
in  areas  of  rapid  chemical  change,  and  consequently,  the 
more  rapid  the  chemical  changes,  the  more  computational 
effort  required  to  solve  for  the  flowfield.  Part  of  this 
thesis  will  attempt  to  find  a method  for  quickly 
calculating  the  equilibrium  chemical  concentrations 
immediately  behind  the  bow  shock  wave  for  oxygen  and 
nitrogen  which  should  eliminate  the  time  consuming  steps 
associated  with  the  rapid  dissociation  processes. 
Obviously,  modelling  the  shock  chemistry  in  such  a fashion 
is  only  valid  for  speeds  at  which  the  oxygen  or  nitrogen 
would  have  dissociated  in  a close  spacial  distance  to  the 
shock  front.  Since  oxygen  will  typically  dissociate  close 
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to  the  shock  at  a much  lower  speed  than  will  nitrogen,  two 
models  will  be  presented.  The  first  will  consider  nitrogen 
concentrations  to  be  frozen  at  the  shock  with  oxygen 
concentrations  being  in  equilibrium  at  the  local 
translational  temperature  immediately  behind  the  shock 
front.  It  is  felt  that  this  model  will  be  valid  in  a 
velocity  range  of  7 to  10  kilometers  per  second.  The  second 
model  will  be  one  in  which  both  oxygen  and  nitrogen 
concentrations  will  be  in  equilibrium  with  the  local 
translational  temperature  of  the  shock  front.  This  model 
will  only  be  valid  at  very  high  speeds  typical  of  a 
re-entry  from  Mars. 

Based  on  past  experiance,  there  are  several 
methods  for  the  determination  of  the  electron  temperature. 
The  first  approach  is  to  include  in  the  flow  model  the 
highly  coupled  electron  energy  equation^".  However,  the 
complexity  and  sensitivity  of  this  equation  makes  the  flow 
equations  difficult  to  solve;  and  for  many  practical 
engineering  applications  this  method  is  too  cumbersome.  A 
second  method  is  based  on  certain  assumptions  about  the 
processes  involved  in  the  electronic  excitation  process.  In 
this  approach,  the  initial  excitation  is  assumed  to  be 
dominated  by  atom-molecule  collisions  followed  by  a flow 
region  where  electronic  excitation  is  strongly  coupled  to 
the  level  of  vibrational  excitation  of  diatomic  nitrogen; 
and  a correlation  was  developed  based  upon  the  chemical 
species  present  and  the  local  translational  or  vibrational 
temperature.  There  has  also  been  strong  evidence  that  the 
electron  temperature  for  both  bound  and  free  electrons  is 
coupled  to  the  vibrational  temperature  of  diatomic 
nitrogen.  An  additional  method  of  determining  the  electron 
temperature,  therefore,  is  to  simply  let  it  equal  the 
vibrational  temperature  of  nitrogen  . Since  a twenty 
percent  change  in  the  electron  temperature  can  cause  an 
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order  of  magnitude  difference  in  the  radiative  heat 
transported  to  the  AOTV  body,  it  is  vital  that  various 
electron  temperature  models  be  investigated  in  this  study. 

To  model  the  radiative  heat  transfer,  several 

options  are  available.  The  quickest  and  easiest  model  to 

4 

use  is  an  optically  thin  radiance  model  . The  radiance 
model  is  based  on  several  radiative  processes,  and  the 
amount  of  thermal  radiation  is  determined  by  the  local 
concentrations  of  the  participating  chemical  species  and 
the  electron  temperature.  In  this  model,  it  is  assumed  that 
the  air  does  not  self-absorb  the  radiation  emitted. 
However,  in  actuality,  a significant  amount  of  the  emitted 
radiation  is  absorbed  by  the  air.  In  order  to  account  for 
this  "non-gray"  absorption,  engineers  have  developed 
several  step  models  that  approximate  the  spectral 
dependance  of  the  absorption  characteristics  of  air.  While 
such  step  models  allow  a quick  determination  of  the 
emission  and  absorption  behavior,  they  differ  in  what 
radiative  effects  are  included.  In  addition,  since  these 
step  models  are  usually  based  on  factors  such  as  local 
species  concentrations,  electron  temperature,  and  local  air 
density,  they  are  quick  and  simple  to  use;  but, 

unfortunately,  the  radiative  heat,  transfers  predicted  by 
them  can  differ  by  as  much  as  a factor  of  two.  In 
principle,  the  radiative  flux  should  be  determined  by 

integrating  the  spectrum  of  air  in  a line-by-line,  band  by 
band  fashion;  but  this  approach  is  usually  too  time 

consuming  to  be  practical  for  most  engineering 

applications.  Thus,  step  models  of  absoption  coefficients 
are  necessary  in  most  cases.  Part  of  this  study  will 
examine  the  radiance  model  and  various  step  models  in  order 
to  determine  their  appropriateness  to  the  flight  regime  . of 
the  AOTV. 

The  final  area  to  be  investigated  will  be  the 
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effect  of  nonequilibrium  corrections  on  the  radiative  heat 
transfer  models  studied.  All  of  the  approximate  radiative 
transfer  models  assume  local  thermodynamic  equilibrium 
(LTE),  which  requires  that  a Boltzmann  distribution  exist 
between  the  excited  states  and  the  ground  state  of  the 
chemical  species  in  the  models.  Under  chemical  equilibrium 

5 

conditions,  this  assumption  is  valid.  However,  Chapin 
indicated  that  under  conditions  of  chemical  and  thermal 
nonequilibrium  certain  correction  factors  might  be 

necessary  to  account  for  any  local  thermodynamic 

nonequilibrium  (LTNE)  deviations  from  a Boltzmann 

distribution  induced  by  chemical  processes  between  excited 
states  and  the  ions  and  electrons  present  in  the  flow. 
Uncorrected,  radiation  models  could  exaggerate  the  actual 
radiatve  transfer  due  to  atomic  processes.  The  effect  of 
the  ionization  correction  factors  will  be  examined  for  each 
of  the  radiative  heat  transfer  models  studied.  In  addition, 
a new  correction  factor  will  be  postulated  that 

approximately  accounts  for  deviations  from  a Boltzmann 
distribution  of  the  electronic  states  of  the  diatomic 
molecules.  Not  including  the  effects  of  such  deviations 
could  also  lead  to  significant  overestimation  of  the 
molecular  radiative  heat  transfer  to  an  AOTV. 
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BASIC  FLOWFIELD  SOLUTION  METHOD 


A flowfield  solution  method  for  the  basic  AOTV 
flowfield  had  to  be  chosen  before  any  of  the  various  models 
of  physical  phenomena  could  be  tested.  Since  uncoupled 
radiative  heat  transfer  could  be  legitimately  assumed  for 
the  speed  regime  of  the  AOTV,  the  choice  of  a solution 
method  could  be  made  independently  of  the  radiation  models. 
However,  there  were  still  several  requirements  for  the 
flowfield  solver.  The  method  had  to  be  adaptable  to  the 
geometry  of  a proposed  AOTV.  In  addition,  in  order  to 
obtain  the  proper  flowfield  properties  for  the  radiative 
heat  transfer  and  electron  temperature  models,  the  solution 
method  had  to  include  nonequilibrium  chemistry,  vibration  - 
dissociation  coupling  models,  and  electronic  excitation. 
The  ability  to  study  the  chemical  reactions  along 
individual  streamlines  was  also  desired  for  the  electron 
temperature  models.  Finally,  as  with  all  computational 
fluid  dynamics  methods,  an  efficient  method  was  essential. 

Consequently, an  inverse  flowfield  solution  method  first 
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proposed  by  Maslen  , and  later  modified  by  Grose  , for 

solving  the  nonequilibrium  inviscid  flowfield  about  blunt 

hypersonic  vehicles  was  selected  as  the  basic  computer  code 

for  this  project. 

With  a strong,  detached  shock  wave,  it  is 
possible  to  define  a shock-oriented,  curvilinear  coordinate 
system  (Figure  1).  After  carrying  out  a Von  Mises 
transformation  on  the  coordinate  system,  the  independent 
variables  are  x,  the  distance  along  the  shock,  and  y>,  the 
stream  function.  In  this  transformed  coordinate  system,  the 
continuity  equation  becomes 
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8 


fL(Pur)  + £_(pvX r)  - 0 
dx  dy 

from  which  the  stream  function  cam  be  defined  as 

dz  = PvrX 
dx 


(1) 


(2) 


and. 


dtp 

dy 


pur 


(3) 


The  momentum  equations  are 
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dv 

1 

3 1 
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dp 

V' 
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(5) 


Shock 


Figure  1.  Shock  Coordinate  System. 
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and  the  energy  equation  is 


fh  =1  5 (6) 

d-x}  \fj  p [dxj  W 

Two  other  equations  are  necessary  to  fully  specify  the 
flowfield.  These  are  the  state  equation 

h — h{PjPj  c^i  Cg*  • ■ • (*7) 

and  the  rate  equation 


l^x  J w u 

Since  the  flow  in  an  inviscid  shock  layer  is 
nearly  parallel  to  the  shock,  it  can  be  assumed  that  the 


is  zero;  and  with  the  additional  assumption  that  X is 


approximately  one,  equation  (5)  becomes 

^ = JL  (9) 

dy)  x RQr 

In  equation  (9),  Maslen  approximated  the  values  forr  and  u 
by  the  values  immediately  behind  the  shock;  and  with  this 
approximation,  equation  (9)  can  be  integrated  to  yield 


P(x,y0  = p(x)  + 


where,  at  the  shock 


Ec(x)  rsU)  l 


vs(x)] 


W = 


P V r 
00  00  s 


(10) 
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and,  on  the  body 


% = 0 


With  this  approach,  equation  (10)  is  thereby 
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decoupled  from  the  solution  of  the  other  conservation 
equations  and  can  be  solved  independently  of  them.  Notice 
that  the  values  of  the  flow  properties  at  the  shock  can  be 
easily  obtained  for  a known  shock  geometry  and  proper 
assumptions  concerning  the  shock  jump  chemistry. 

Since  the  flow  closely  parallels  the  shock  at 
hypersonic  velocities,  it  can  further  be  assumed  that 


v2  - v 2 « u2 
o 


The  conservation  of  energy 


u v v 

h + — * ~T  = ho  * ~t 


(13) 


(14) 


cam  then  be  used  to  solve  for  the  velocity 


u = 


(15) 


Grose’s  modification  of  Maslen’s  method  allowed 
the  internal  energy  of  the  gas  to  include  the  effects  of 
translational,  rotational,  and  vibrational  motion,  as  well 
as  the  effects  of  dissociation,  electronic  excitation,  and 
ionization  of  the  chemical  species.  Accordingly,  the 
internal  energy  of  the  ith  species  is 


(16) 


In  Grose’s  original  computer  code  the  vibrational  energy 
was  found  by  one  of  two  methods  at  the  user’s  discretion. 
The  first  option  assumed  vibrational  motion  to  be  in 
equilibrium  with  the  translational  mode  of  motion,  and 
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for  this  case  the  vibrational  energy  is  simply 


c 

V,  1 


fiRei 


- i] 


(17) 


The  second  option,  a Coupled  Vibration  - Dissociation  (CVD) 
8 

model  , assumes  that  vibrational  energy  is  not  in 
equilibrium  with  the  translational  energy.  In  the  CVD 
model,  vibrational  energy  can  be  represented  by  a system  of 
simple  harmonic  oscillators  where  the  rate  of  change  of 
vibrational  energy  is 


&C  £ - £ 

V,  1 _ V,  100  v,  1 


d-t  T 


(18) 


The  CVD  model  then  relates  the  effects  of  vibrational 
nonequilibrium  to  dissociation  by  the  use  of  a coupling 
coefficient,  which  is  a correction  factor  to  the  forward 
chemical  rate  that  reflects  the  difference  between  the 

Q 

actual  forward  rate  and  the  local  forward  rate  if 
vibrational  equilibrium  existed. 

Q 

In  a related  work,  Bobskill  added  three 
additional  vibrational  nonequilibrium  models  to  the  Grose 
computer  code.  The  first  of  these  is  the  Coupled  Vibration 
- Dissociation  - Vibration  (CVDV)  model**  where  the  rate  of 
change  of  vibrational  energy  is  represented  by 
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The  first  term  in  equation  (19)  is  the  vibrational  rate 
term  found  in  the  CVD  model.  The  second  term  represents  the 
average  energy  lost  by  the  dissociation  of  a single 
molecule,  while  the  third  term  represents  the  vibrational 
energy  gained  through  the  recombination  of  a molecule.  The 
coupling  factor  in  the  CVD  model  is  again  used  to  relate 
the  effects  of  vibrational  nonequi 1 ibr iura  on  the 
dissociation  reactions. 

The  second  vibrational  nonequilibrium  model  added 
by  Bobskill  was  the  CVDV  - Preferential  model^.  In  the  CVDV 
- Preferential  model,  it  was  assumed  that  dissociation 
preferentially  occurs  from  the  higher  energy  vibrational 
levels.  By  contrast,  the  CVD  and  CVDV  models  assumed  that 
dissociation  can  occur  with  equal  probability  from  any 
vibrational  level.  In  addition,  the  CVDV  - Preferential 
model  assumes  that  vibrational  energy  can  be  represented  by 
a system  of  anharmonic  oscillators,  while  the  CVD  and  CVDV 
models  assumed  a system  of  simple  harmonic  oscillators.  The 
rate  of  change  of  vibrational  energy  in  the  CVDV  - 
Preferential  model  is  then 
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V,  X _ V,  100  V 

<?t  T 


,i  + (Eili 


T . ) - c 
v.  l _ v_ 


J 


n 


an 

w d 


G(T)  - eVm.) 
n 

The  final  vibrational  nonequilibrium  model  ' added 
by  Bobskill  was  the  two  temperature  chemical-kinetic  "Chul 
Park  - Like"  (CPL)  *model^.  The  CPL  model  assumes  that  the 
effective  electron  temperatures  are  equal  to  the  nitrogen 
vibrational  temperature,  while  the  rotational  temperature 
is  in  equilibrium  with  the  translational  temperature.  The 
rate  of  vibrational  nonequilibrium  can  then  be  represented 


an 

L '^t  J 


(20) 
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by 
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where 


(-5000/T  ) 

S = 3.5  e S (22a) 

r,  = r + r (22b) 

i c 

tq  = 1 / (nOy)  (22c) 

= 10~17(50000/T)2  ( 22d ) 


The  rate  of  change  in  equation  (21)  has  an  additional 

multiplier  on  the  first  term  that  accounts  for  the 

nonlinear  variation  in  the  vibrational  relaxation  rate  with 

the  difference  in  vibrational  energies.  The  CPL  model 

further  assumes  that  there  is  a limiting  cross  section  (o-  ) 

at  the  high  temperatures  in  the  shock  front.  The  equations 

in  (22)  are  correction  factors  to  the  linear  assumption.  In 

3 

the  original  Park  model  , it  was  assumed  that  the 

temperatures  used  .to  compute  the  forward  dissociation 
reactions  should  be  a geometric  average  of  the 

translational  temperature  and  the  vibrational  temperature: 


T = /Tf 
a V v 


13^ 


(22) 
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In  this  way,  the  forward  rates  are  properly  reduced  due  to 
vibration  - dissociation  coupling.  However,  in  the  present 
CPL  model,  equation  (22)  is  not  used  because  it  is  very 
approximate  and  the  previously  discussed  coupling 

coefficient  is  used  instead.  In  addition,  in  the  actual 
Park  model  a combined  electron  - vibrational  energy 
equation  is  used  which  not  only  accounts  for  vibrational 
and  electron/electronic  energy  changes  but  also  includes 
vibrational  - electronic  coupling.  However,  in  the  present 
model  it  is  assumed  that  electron/electronic  effects  on 
vibrational  energy  are  small,  but  that  the  nitrogen 
vibrational  effects  on  the  effective  electron  temperature 
are  very  strong.  With  this  assumed  one-way  coupling,  the 
nitrogen  vibrational  energy  and  temperature  can  be  computed 
using  equation  (21)  and  the  electron  temperature  is  assumed 
equal  to  TvN2. 

In  addition  to  modelling  the  vibrational 
energy,  it  is  also  necessary  to  model  the  chemical 

7 

reactions.  Following  the  discussion  of  Grose  , an  arbitrary 
chemical  reaction  can'  be  represented  as 

I I 

Y.vis i ^ I <23) 

i=l  i=l 

By  the  law  of  mass  action,  the  rate  of  production  of 
species  is  in  direct  proportion  to  the  product  of  the 
concentration  of  each  species  raised  to  power  of  its 
stochiometric  coefficient.  The  rate  of  production  of  a 
species  S.  per  unit  mass,  is  then 

1 i 


dt 


(24) 
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In  Grose's  coordinate  system,  and  noting  that 


equation  (24)  can  then  be  represented  as 


where 


(25) 


(26) 
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The  vibrational  coupling  factor  (<t> -)  is  simply  multiplied 

J 

on  the  right  hand  side  of  equation  (26)  to  incorporate  the 
effects  of  vibrational  nonequilibrium 
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Since  the  Grose  method  is  an  inverse  one,  the 
first  step  in  the  general  solution  procedure  is  the 
specification  of  the  shock  shape,  where 

r = r (z)  (29) 

s s 

radius  of 
coordinate 

(30a) 


The  local  shock  inclination  angle  (©),  the 


curvature  (R  ),  and  the  x - direction 
c 

can  then  be  found  from 
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Rc  = 


“ 

fdr  1 

2' 

1 + 
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ds 
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(30b) 
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frsJ^_ 

J0  sin  6 


(30c) 


With  the  freestream  conditions  specified  by  user  input,  the 
next  step  in  the  solution  procedure  is  the  determination  of 
the  translational  temperature  immediately  behind  the  shock 
(T  ).  In  order  to  accomplish  this  task,  Grose  specified  the 
three  oblique  shock  conservation  relations  by 


A(x)  = p^V^sinO) 


Ola) 


for  the  conservation  of  mass,  and 


O(x)  = + P^V2  sin20) 


(31b) 


for  the  conservation  of  momentum,  and  finally 


X(  , ^sin2^) 

c5(x)  = e + + l 

2 


(31c) 


for  the  conservation  of  energy.  With  an  initial  guess  of  T 

5 

made  by  the  Rankine  - Hugoniot  relations,  the  internal 

energy  at  the  shock  (e  ) can  be  found  from  equation  (16). 

s 

The  second,  and  subsequent,  iterations  for  T are  then 

s 

determined  by 


2poo(«5  eg)y  _ 2A2(6  - e ) 
i - s 

s ^zizziiiizi^zzizzizr"^ 

rT  n + /n2  - 2a2(<5  - eg) 


02) 


17 


where  equation  (32)  represents  all  three  shock  conservation 
equations  solved  for  T . The  requirement  that  enthalpy 
remains  constant  along  a streamline  is  used  as  the  basis 
for  the  iterations.  Once  the  value  of  T differs  from  the 
previous  value  by  a user  - specified  tolerance,  the 
remaining  shock  parameters  can  be  found  from 


(33a) 

(33b) 


hs  = es  + 


(33c) 


us  = Voocos<e>  (33d) 

The  determination  of  T will  be  modified  later  in  this 

s 

study  to  incorporate  a proposed  shock  jump  chemistry  model. 

The  pressure  distribution  in  the  Von  Mises  plane 

can  then  be  obtained  from  equation  (10).  With  the  pressure 

distribution  known,  the  chemical  rate  and  vibrational 

energy  equations  can  be  integrated  along  with  the  equations 

for  flow  properties  along  streamlines  to  find  h,  c.,  c 

1 v,  1 

p,  and  T.  The  complete  flowfield  is  then  determined. 


lib 
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FLOW  PROPERTY  MODELS 


Development  of  the  Shock  Jump  Chemistry  Model 

In  the  region  of  nonequilibrium  chemistry  behind 
the  shock  wave  of  an  AOTV  transferring  from  high  to  low 
Earth  orbit,  the  diatomic  oxygen  present  in  Earth's 
atmosphere  will  quickly  dissociate  into  atomic  oxygen.  At 
the  velocities  during  the  intial  re-entry  phase  of  an  AOTV 
returning  from  Mars,  both  the  diatomic  oxygen  and  the 
diatomic  nitrogen  in  the  atmosphere  will  similarly 
dissociate  immediately  behind  the  shock  front.  Most 
computational  methods  for  solving  a hypersonic  flowfield 
rely  on  the  fact  that  total  enthalpy  remains  constant  along 
a streamline.  Consequently,  in  order  to  maintain  this 
requirement  in  regions  of  rapid  chemical  changes, 
computational  methods  must,  to  preserve  accuracy,  reduce 
the  spatial  distance  of  each  computational  step.  The  net 
result  of  this  rapid  dissociation  of  diatomic  oxygen  and 
diatomic  nitrogen  at  high  velocities  is  a significant 
increase  in  the  computational  time  necessary  to  calculate 
the  flowfield  in  the  chemical  nonequilibrium  region. 

In  order  to  possibly  decrease  the  time  necessary 
to  calculate  the  flowfield  of  an  AOTV,  this  study 
investigated  the  use  of  a model  that  will  solve  for  the 
chemical  concentrations  and  temperature  at  the  shock  front 
if  oxygen,  or  both  oxygen  and  nitrogen,  were  in  chemical 
equilibrium  at  the  translational  temperature  immediately 
behind  the  shock  front.  Of  course,  this  model  had  to 
preserve  conservation  of  mass,  momentum,  and  energy.  Two 
models  were  developed,  and  the  first  of  these  calculates 
the  equilibrium  concentration  of  atomic  and  diatomic  oxygen 
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at  the  shock  front  while  keeping  the  concentration  of 
diatomic  nitrogen  frozen.  The  second  model  calculates  the 
equilibrium  concentrations  of  atomic  and  diatomic  oxygen  as 
well  as  the  equilibrium  concentrations  of  atomic  and 
diatomic  nitrogen  at  the  shock  front. 

The  first  model  was  developed  on  the  assumption 
that  the  only  dissociative  reaction  for  oxygen  is 


o2  ^ 0 + 0 


Then, 


by  the  law  of  mass  action  for  a diatomic 


gas 
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(34) 


where  ft  is  defined  as  the  ratio  of  the  number  density  of 
dissociated  oxygen  atoms  to  the  number  density  of 
previously  undissociated  oxygen  atoms,  and  is  defined 
as  the  number  density  of  the  previously  undissociated 
oxygen  atoms.  Since  the  concentration  of  nitrogen  is  frozen 
at  the  shock  front,  total  density  at  the  shock  can  be 
defined  as 


P = Pv 


12  + p0 


+ P, 


02 


or,  by  rearranging 


and,  noting  that 


N0co  = N0  + 
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(35) 
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equation  (36)  can  be  further  rearranged  as 
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Substituting  this  result  into  equation  (34)  yields 
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By  noting  that 


P p 

s 00 


P = 
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equation  (39)  then  becomes 
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With  intial  estimates  of  T and  P made  from  the  Rankine 

s s 

Hugoniot  relations  at  the  shock,  the  quadratic  formula  can 
be  used  to  solve  equation  (41)  for  ft.  With  ft  determined  and 
the  freestream  concentrations  known,  the  mass  fractions  for 
atomic  and  diatomic  oxygen  are 


C0  “ ^C02co 


(42a) 


C02  " (1  /?)C02oo 


(42b) 


These  concentrations  can  then  be  used  to  determine  the 
internal  energy 
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(43) 


The  er  subsequently  determines  the  enthalpy,  and  equations 
(32)  and  (33)  can  be  used  in  the  Grose  code  to  make  another 
estimate  of  T . Equations  (41)  and  (42)  are  in  turn  used  to 
make  new  estimates  of  the  atomic  and  diatomic  oxygen 
concentrations,  and  the  whole  process  is  repeated  until 
differs  by  a small  amount  from  the  previous  iteration. 

The  determination  of  the  equilibrium 

concentrations  of  oxygen  and  nitrogen  at  the  shock  follows 
a similar  pattern.  The  assumption  is  made  that  two 
independent  chemical  reactions  were  responsible  for  the 
dissociation  of  oxygen  and  nitrogen 


o2  ^ 0 + 0 


N2  N + N 


Then,  at  the  shock,  the  density  is 

p ~ PN  + PN2  + p0  + p02 

or. 


(C 


N 


CN2} 


) = 


+ P, 


02 


(44) 


(45) 


and,  further  simplification  of  the  oxygen  dissociation 
process  leads  to 

- f1  ' CN2»]  = «0«  <46> 

m0 

and,  for  nitrogen  dissociation, 

- f1  - C02»]  = NN»  <47> 

"N 


22  . 


Using  the  law  of  mass  action  for  each  independent  chemical 
reaction  yields 


1 - ft, 


Q.  _ 


2NOoo  |qJ2  exp[edo/Ts] 


for  oxygen,  and 


- ^ _ 2N  . 

«2  - ^Noo  12 


N 


w 


e^Kn/Ts) 


(48) 


(49) 


for  nitrogen. 

As  in  the  first  shock  jump  chemistry  model, 
equations  (48)  and  (49)  can  be  further  reduced  to 


1 " fir 


2P  w 
s oo 


(H/V*VRTS 


[*  CN2oo) 


r 2' 
ti 


nm^k 


3/2 


w 


-3/2 


^2 


(50a) 


for  oxygen,  and 


1 - fi 


2P  tJ 


N 


N 


( 1+^30+/5n 


) RT  C02co] 


_h?' 

nmNk 


3/2 


w 


-3/2 


Qel 

v QrotQvib  ^N2  /T  1 

QN2  QN2  J-QelJ2  exp[0dn/TsJ 


(50b) 


for  nitrogen.  Equations  (50)  are  a system  of  two 

independent  nonlinear  equations  of  two  unknowns  (/?Q  and  fi^) 

that  can  be  solved  by  a Newton  - Raphson  iteration  with 

estimates  of  T and  P . The  corresponding  mass  fractions 
s s 

are 


C0  " /?0C02co 


(51a) 


J>Hl 
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C02  “ (1_/?0^C02oo 


CN  " ^NCN2» 


CN2  “ (1  /3N)CN2co 


(51b) 
(51c) 
( 51d) 


which  can  be  used  to  calculate  the  internal  energy.  The 

same  iteration  process  as  in  the  first  model  is  used  to 

determine  the  T . 

s 

It  is  very  important  to  note  that  the  shock  jump 
chemistry  models  are  only  valid  in  certain  ranges  of 
freestream  velocity.  The  first  model  is  only  expected  to  be 
valid  for  velocities  around  10  km/sec,  while  the  second 
model  should  be  valid  for  velocities  above  12-13  km/sec. 


Electron  Temperature  Models 

In  the  region  of  chemical  nonequilibrium 
immediately  behind  a stong  shock,  thermal  nonequilibrium 
develops  between  the  translational  mode  of  energy  of  the 
atoms  or  molecules  and  the  translational  energy  of  the 
electrons.  Due  to  their  low  mass  relative  to  that  atoms, 
collisions  are  an  inefficient  process  for  equilibrating 
electrons  with  the  heavy  particles.  In  principle,  the  full 
electron  energy  equation  can  be  used  to  solve  for  the 
electron  temperature,  but  the  electron  energy  equation  is 
highly  coupled  and  very  time  consuming  to  solve. 

Unfortunately,  since  radiation  is  governed  by  the  electron 
temperature,  the  accurate  determination  of  the  electron 
temperature  is  essential  for  accurate  radiative  heat 
transfer  predictions.  For  this  study,  two  types  of  electron 
temperature  models  were  investgated  for  the  AOTV  flowfield. 

The  first  electron  temperature  model  was 

developed  by  Carlson  and  Rieper  , and  is  essentially  a 

3 Hi 
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correlation  between  experimental  radiation  data  and  a 
chemical  reaction  model.  In  the  Carlson  and  Rieper  model  it 
was  assumed  that  radiation  in  the  N2(l+)  band  was  the 
result  of  two  reactions  involving  excited  states.  In  the 
first  step,  a nitrogen  atom  is  collisionally  excited  from 
the  ground  (or  X state)  to  the  A state,  which  was  assumed 
to  be  in  equilibrium  with  the  B state  of  the  nitrogen 
molecule.  The  molecules  in  the  B state  then  radiate  down  to 
the  A state. 

The  initial  excitation  can  be  expressed  by  the 

reaction 


N2(X)  + M N2(B)  + M 
while  the  radiative  emission  is  governed  by 


N2(B) 


Ng( A)  + hv 


(52) 


(53) 


The  rate  of  change  of  the  B state  can  be  expressed  as 

dCB1  = kf„K<X)]M  - kf„[N2(B)]M  -k53[N2(B>]  <54> 


dt 


From  the  law  of  mass  action,  equations  (53)  and  (54) 
become 


CN2(B)3  = 

[N2(X)3 

kf 

. tS2  _ 


5e 

Q 


xj 


exp(-EBX/kTg) 


52 


Q 


Xj 


exp(-EBX/kTi) 


With  the  assumption  that  the  B state  is  in 
equilibrium,  the  rate  of  change  of  the  B state  is 


(55) 


(56) 


local 


d[B]  =0  (57) 

dt 

Carlson  and  Rieper  then  rearranged  equation  (54)  to  give 


1H3. 
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Ti 


T = 
e 


1 + (kTi/Efix)ln[l  + Qb/Qx/(K[M]) 


(53) 


where 


K = C/k53  (59) 

and  C and  k^3  were  experimentally  determined  by  Carlson  and 
Rieper.  The  initial  excitation  of  the  N2(l+)  radiative 
emission  was  assumed  to  be  dominated  by  atom  - molecule 
collisions.  Therefore,  the  first  collision  partner  is 

CM]  = [0]  + [N] 

and  T^  becomes  the  trains  1 at ional  temperature.  Equation  (58) 
then  becomes 


T 

Te  = 1 + (T/85000)ln[l  + {10. l/( [N]+[0] )K>] 


(60) 


and 

K = 4.  23x10_6T“2, 88cm3  (61) 

However,  after  the  vibrational  temperature  has 
peaked,  the  excitation  process  is  assumed  to  be  governed  by 
vibrational  - electronic  coupling.  The  corresponding  Tg  can 
then  be  predicted  through  equation  (58)  by 


Tv 


N2 


Te  1 + (TvN2/85000)ln[l  + ( 10. l/[N2]Kv) j 


(62) 


and 


K = 6. 4xl059TvMO  19 cm8 
v N2 


(63) 


It  is  important  to  note  that  the  correlations  developed  by 
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Carlson  and  Rieper  were  derived  from  data  obtained  in  a 
shock  tube  for  velocities  at  6.4  km/sec. 

Incorporating  the  Carlson  and  Rieper  model  into 
the  Grose  computer  code  proved  to  be  relatively  simple 
since  the  Grose  code  already  calculated  translational  and 
vibrational  temperatures  along  a streamline.  All  that  was 
necessary  to  use  the  Carlson  and  Rieper  model  was  to 
determine  the  number  density  of  atomic  oxygen  and  nitrogen 
and  the  number  density  of  diatomic  nitrogen.  The  number 
densities  along  a streamline  were  found  by  using  the 
already  determined  density  and  mass  fractions  by 

N.  = pNavCi  (64) 

pi 

where  N is  the  number  density,  and  N&v  is  Avagadro’s 
number. 

The  second  model  used  in  this  study  is,  in 

3 

reality,  more  of  an  assumption.  Park  has  stated  that  the 
energy  equilibration  between  the  translational  energy  of 
free  electrons  and  the  vibrational  motion  of  diatomic 
nitrogen  is  very  rapid.  In  addition  to  Park,  Lee^’ ^ found 
the  same  to  be  true.  With  the  rapid  equilibration  of  the 
temperature  characteristic  of  the  free  electrons  to  the 
vibrational  temperature  of  diatomic  nitrogen  and  with  the 
assumption  that  free  and  bound  electrons  are  characterised 
by  the  same  temperature,  the  vibrational  temperature  of 
diatomic  nitrogen  can  be  used  as  the  electron  temperature 
when  solving  for  the  radiative  heat  transfer.  Since  the 
Grose  method  already  determined  the  vibrational  temperature 
of  nitrogen,  the  vibrational  temperature  information  only 
had  to  be  retained  in  order  to  use  this  assumption.  It 
should  be  noted  that  in  the  present  study  it  is  inherently 
assumed  that  the  vibrational  - electronic  coupling  is 
essentially  one  way.  In  other  words,  vibrational  processes 
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strongly  influence  the  electron  temperature  but  the 
electrons  only  have  a small  influence  on  the  vibrational 
energy.  It  is  believed  that  this  equilibration  of  T and 

W 

^vN2  as  long  as  there  is  a reasonable  amount 

of  nitrogen  molecules  in  the  flow. 


Radiative  Heat  Transfer  Models 

For  this  study,  four  radiative  heat  transfer 

models  were  examined.  One  of  these  models  is  an  optically 

thin  radiance  model,  while  the  other  three  are  non-gray 

4 

step  models.  In  the  radiance  model  , the  air  was  assumed  to 

be  non-absorbing  of  the  radiation  it  emitted  by  it.  A set 

of  rate  equations  was  then  fit  to  the  predictions  of 
12 

Nardone  et  al  to  calculate  the  radiation  emmited  by  a 
small  volume  of  gas.  The  rate  equations  are  of  the  form 

Rad  = AkNjN1exp(-Bk/Te)  (65) 

where  Rad  is  the  radiative  energy  emitted  per  steradian  by 

the  kth  radiation  process,  and  Ak  and  Bk  are  constants.  The 

original  radiance  model  contained  equations  for  twelve  of 

these  radiative  processes,  and  this  study  incorporated  a 

+ 13 

thirteenth  process  for  the  radiation  in  the  ^(1-)  band 
To  incorporate  the  radiance  model  into  the  Grose  code  it 
was  necessary  to  retain  the  number  density  and  electron 
temperature  data  over  the  flowfield.  The  data  was  then  used 
to  calculate  the  radiation  by  the  radiance  equations  and 
the  radiation  was  integrated  over  space  to  obtain  the  total 
radiative  flux  to  the  body. 

The  non-gray  step  models  are  approximate 
representations  of  the  self  - absorption  characteristics  of 
air,  and  the  steps  model  the  variation  of  the  absorption 
coefficient  with  wavelength  over  the  total  spectrum.  The 
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non-gray  step  models  represent  an  increase  in  the 
sophistication  of  radiative  heat  transfer  modelling  over 
the  radiance  model  in  that  much  of  the  radiation  emitted  by 
a gas,  particularly  in  the  ultraviolet  region,  is  self  - 
absorbed  by  the  gas,  and  the  radiance  model  can  over-state 
the  radiative  flux  to  the  surface  of  an  AOTV. 

The  first  step  model  used  in  the  Grose  code  was 
developed  by  Olstad^.  It  contains  eight  steps  which 
represent  various  portions  of  the  ultraviolet,  visible,  and 
infrared  regions  of  the  electromagnetic  spectrum  (Table  1); 
and  it  includes  effects  due  to  atomic  and  molecular 
processes  of  both,  nitrogen  and  oxygen.  One  of  the  steps, 
step  7,  is  a "picket  fence"  representation  of  the 
ultraviolet  line  radiation;  and  another  step,  step  6, 
represents  the  continuum  background  and  effects  due  to  the 
line  broadening  in  the  same  region.  As  shall  be  seen  later, 
there  exists  the  possibility  that  this  step  is  slightly 
incorrect  due  to  the  fact  that  the  Olstad  model  was  derived 
at  higher  densities  than  those  present  in  an  AOTV  flowfield 
and  that  the  radiative  cross-  sections  used  are  too  large. 
While  no  temperature  range  was  given  for  the  Olstad  model, 
a velocity  regime  of  10.7  to  15.2  km/sec  at  an  altitude  of 
61  km  was  used  by  Olstad,  and  the  AOTV  flowfield  should 
fall  within  the  region  of  applicability  of  the  Olstad 
model . 

The  second  step  model  (KCN)  used  was  developed  by 
15 

Knott,  Carlson,  and  Nerem  . The  KCN  model  was  originally 
derived  from  experimental  data  for  pure  nitrogen  and 
correlated  to  air.  Since  the  radiative  emmission  in  air  is 
dominated  by  nitrogen,  it  was  felt  that  this  was  a valid 
approximation.  The  model  consists  of  five  bands  and  is 

applicable  to  air  temperatures  from  the  8,000  to  20,000  °K. 

1 6 

The  final  step  model  used  was  that  of  Anderson  , 
and  it  consists  of  two  steps.  The  first  step  accounts  for 
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Olstad 

Band 

1 

400 

- 852 

2 

852 

- 911 

3 

911  • 

- 1020 

4 

1020 

- 1130 

5 

1800 

- 4000 

6 

1130 

- 1800 

7 

1130 

- 1800  Line 

8 

4000 

- 00 

KCN 

Band 

1 

620 

- 1100 

2 

1100 

- 1300 

3 

1300 

- 1570 

4 

1570 

- 7870 

5 

7870 

- 9552 

Anderson 

Band 

1 

0 - 

1100 

2 

1100 

- 00 

Table  1. 

Step  Model  Band  Frequencies 

absorption  behavior  in  the  vacuum  ultraviolet  region  of  the 
spectrum,  while  the  second  step  represents  the  absorption 
in  the  visible  and  infrared.  The  two  step  model  is  quick 
and  easy  to  use,  but  the  model  was  derived  for  high 
temperature  equilibrium  air  in  the  region  of  3,000  to 
15,000  °K.  The  applicability  of  the  Anderson  model  to  a 
nonequilibrium  A0TV  flowfield  is  subject  to  some  question 
since  the  temperatures  near  the  shock  at  10  km/sec  approach 
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35,000  ° K. 

The  tangent  slab  approximation  was  made  for  all 
of  the  radiative  heat  transfer  models  used  in  this  study. 
According  to  the  tangent  slab  approximation,  the  radiative 
flux  to  the  surface  is  determined  by  the  flow  properties 
along  a line  perpendicular  to  the  surface  of  the  AOTV. 
Along  with  the  tangent  slab  approximation,  the  assumption 
was  made  that  the  surface  of  the  AOTV  was  non-emitting  and 
that  no  precursor  effects  were  present  in  the  flowfield. 
Accordingly,  the  total  radiative  heat  transferred  to  the 
surface  of  the  AOTV  can  be  represented  by 

oo  y^ 

qr  = 2n  J J S(y)E2[r (y) ]«(y)dydv  (66) 

0 0 

Each  of  the  radiative  heat  transfer  models  was 
incorporated  into  the  Grose  code  in  separate  subroutines. 
All  data  necessary  for  their  use  was  retained  in  the  main 
part  of  the  Grose  code,  and  the  individual  radiation  models 
called  at  the  user’s  discretion. 


Nonequilibrium  Correction  Factors  For  Radiation 

The  preceding  radiative  heat  transfer  models  were 

all  derived  with  the  assumption  that  the  electronic  states 

of  the  radiating  particles  were  populated  according  to  a 

Boltzmann  distribution  at  the  local  T . In  a Boltzmann 

s 

distribution,  the  local  population  of  a given  energy  state 
(N^)  can  be  described  by 


* g, exp( -c  /kT) 

< - N -1 5^ 


(67) 


However,  there  is  evidence  that  nitrogen  and  oxygen 


ionization  is  a two  step  process  involving  excitation  to  an 

excited  state  followed  by  rapid  ionization,  in  which  it  can 

be  assumed  that  the  excited  states  are  in  equilibrium  with 

the  electrons  and  ions  at  the  local  T and  pressure. 

© 

Consequently,  the  radiative  heat  transfer  models  need  to  be 
corrected  for  the  fact  that  the  electronic  states  are  not 
that  predicted  by  a Boltzmann  distribution  assuming  local 
thermodynamic  equilibrium.  It  should  be  noted  that  the 
following  correction  factors  are  only  engineering 
approximations  of  the  actual  phenomena. 


Atomic  Correction  Factors 


To  derive  the  correction  factors  for  radiative 
processes  involving  atoms,  it  is  necessary  to  consider  four 
energy  level  transitions.  The  first  is  the  transition  of  an 
electron  from  the  continuum  state  to  an  excited  state. 
Before  deriving  the  correction  factor  for  this  type  of 
transition,  it  is  necessary  to  define  the  continuum 
frequency  - dependant  absorption  coefficient  (xv)  as 


%(P)  = N(p)  hv  B^ 


N ( p) 

N 7^  exP<-hv/kTe> 


(68) 


where  the  second  term  in  the  bracketed  expression  of 
equation  (68)  can,  if  necessary,  be  approximated  as  small 
compared  to  one.  The  source  function  is 
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v 


N(p)e  2hv3 

N(P)  "X 
c 


exp(hi>/kTe) 


N(p)e  'l 
N(P) 


(69) 


and,  the  equation  of  radiative  transfer 


is 


32 


dl. 


ds 


(70) 


where  the  subscript  e denotes  the  number  of  atoms  in  the 

excited  state  p,  if  p were  in  equilibrium  with  the  ions  and 

electrons  at  the  local  T and  pressure.  When  in 

8 

chemical  and  thermodynamic  equilibrium 


_ < (VI) 

N(p)  " 1 

and  the  source  function  becomes  the  black  body  function 

(By).  For  this  type  of  transition,  since  excited  states  are 

in  equilibrium,  N(p)  = N(p)  . Then,  by  the  law  of  mass 
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action 


NeMr,h3 

N(P)  = 575 — ex'P 

2(2nmekTe)3/2QeI 


;*(VkTJ 


(72) 


By  the  definition  of  the  degree  of  ionization  and  the 
degree  of  dissociation,  equation  (72)  can  be  re-written  as 


4N  ap2*2 


N(P)e  = 


2«m  kT 
e e 


3/Ixp(-xp/kTe)  Q 


(73) 


el 


Now,  by  definition 


i (74) 

. 2Na/J(l-a)  " i 

By  multiplying  the  right  - hand  side  of  equation  (73)  by 
the  left  - hand  side  of  equation  (74)  and  making  the 
assumption  that  the  number  density  of  the  ground  state  is 
equal  to  the  number  density  of  atoms  (N^)>  the  law  of  mass 


if  I 
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action  yields 


N(p)  = N(p)  = ILflfii  Nj 
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(1‘a)  tf«2 
e e 
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/ exp(c  /kT  ) 
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^ -1 


and  the  absorption  coefficient  becomes 
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[l  - exP(-hv/kTe)J 


(76) 


By  redefining  the  terms  after  NA  on  the  right  - hand  side 
of  equation  (76)  as  the  radiative  cross-  section  (o'),  the 
absorption  coefficient  can  be  written  as 


x 

V 


= ftcx 

u^7 


(l-c 


ft  O2 
e e 
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nac 


(77) 


and  the  source  function  becomes  the  black  body  function. 

For  a transition  from  a continuum  state  to  the 
ground  state,  N(l)  does  not  equal  N(l)p.  However,  the 
assumption  that  N(l)  = NA  still  -holds.  The  absorption 
coefficient,  equation  (68),  then  becomes 


^ (78) 

where  the  cross  - section  is  defined  as  before. 

Next,  utilizing  the  law  of  mass  action  once 
again,  the  equilibrium  number  density  of  the  ground  state 
can  be  found  from 


16 


I 


34 


N<1)  = 


By  definition 
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and. 
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From  the  Saha  equation,  it  cam  be  shown  that 


(80) 


(81) 


(l-«) 
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27Tm  kT 
e e 
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fil_  exp(-£/kTe) 


(82) 


Substituting  equation  (82)  into  (81)  and  reducing  the 
resulting  expression  yields 


N(l)  ft  a (l-«  ) 

2 — — 2. — 


N(l) 


e e 


(83) 


The  substitution  of  equation  (83)  into  the  definition  of 
the  source  function,  equation  (69),  results  in 


ft*  (1 -®  ) 

C — — *D 

* " d-“)  /3  a2  ” 

e e 


(84) 


For  line  radiation,  the  absorption  coefficient 
and  source  function  are  defined  as 


K = N(p)B  B hv 

v Jr/  pq  v 


N(q) 

1 " n7p7  exP(-hv/kTe> 


(85) 
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e 


(86) 


Since  both  excited  states  are  assumed  to  be  in  equilibrium 
at  the  local  electron  temperature  the  source  function  can 
be  replaced  by  the  black  body  function.  The  absorption 
coefficient  is  the  same  as  equation  (77). 

In  the  models  of  radiative  heat  transfer,  the 

atomic  terms  in  the  first  four  bands  of  the  Olstad  model, 

the  first  band  of  the  KCN  and  Anderson  models,  and  selected 

equations  of  the  radiance  model  involve  transitions  to  the 

ground  state,  or  a state  very  close  to  the  ground  state, 

and  their  black  body  functions  were  modified  accordingly. 

In  the  remaining  bands,  the  atomic  terms  in  the  Olstad 

model  and  the  remaining  bands  in  the  other  models  all 

involved  transitions  to  an  excited  state.  Their  absorption 

coefficients  were  similarily  corrected  for  the  LTNE 

condition.  The  values  of  a and  ft  were  found  from  a method 

e e 

17 

suggested  by  Fay  and  Kemp  as  funtions  of  T , while  a and 
ft  where  determined  by  adding  the  appropriate  number 
densities  found  from  the  chemical  reactions.  The  actual 
degree  of  ionisation  is  simply  the  ratio  of  the  number 
density  of  ions  to  the  sum  of  the  number  densities  of  ions, 
atoms,  and  twice  the  number  density  of  the  molecules.  The 
actual  degree  of  dissociation  is  the  ratio  of  the  sum  ox 
the  number  densities  of  the  ions  and  atoms  to  the  sum  of 
the  ions,  atoms,  and  twice  the  number  density  of  the 
molecules . 


Molecular  Correction  Factors 

A LTNE  condition  similar  to  that  previously 
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outlined  for  atomic  radiative  processes  will  exist  if  it  is 
assumed  that  the  electronically  excited  molecules  are  in 
equilibrium  with  their  atomic  counterparts  at  the  local 
and  pressure.  The  later  essentially  assumes  that 

dissociation  is  dominated  by  collisional  phenomena. 

If  a transition  from  an  upper  excited  state,  B, 
to  a lower  excited  state,  A,  is  hypothesized,  the 
absorption  coefficient  can  be  expressed  as 


= N { B ) O' 


1 - exp 


(-hv/kTe) 


(87) 


where  the  bracketed  term  on  the  right-hand  side  of  equation 
(87)  is  approximately  one,  and 


N(B)  = NNz(B)  (88) 

The  problem  is  how  to  express  the  number  density  of  the 
excited  diatomic  nitrogen  [N^2(B)]  in  terms  of  the  number 
density  of  the  ground  state  diatomic  nitrogen  [N^2(l)]  that 
is  obtained  in  the  modified  Grose  code. 

First,  assuming  that  the  population  of  the  B 
state  is  in  equilibrium  with  the  atoms  and  that  the  number 
density  of  the  ground  state  is  approximately  equal  to  the 
number  density  of  diatomic  nitrogen,,  then,  from  the  law  of 
mass  action. 


or. 


N 

_N_ 

N(B) 


= _?H_  exp 


Q. 


B 


(-£NB/kTh] 


N(B)  = 


nn8b 


Q 


N 


exp(*NB/kTh  ] 


(89) 


(90) 


Now,  in  equilibrium 


37 


1-73 


e 


Vel1-/ 


(91) 


■then,  using  the  definitions  of  the  degree  of  dissociation 
and  the  degree  of  ionization,  and  combining  the  above 
expressions,  equation  (90)  becomes 


N(B) 


tf2<  l-*>2  ( l-/3e) 


(1) 


exp( -c1B/kTe) 


(92) 


where  the  bracketed  term  on  the  right-hand  side  of  equation 
(92)  is  defined  as  the  radiative  cross-  section.  The 
absorption  coefficient  then  becomes 


(*1 

v ^2(l-«  )2  BA 

e e 


(93) 


while  the  source  function  is  simply  the  black  body 
function. 

The  absorption  coefficients  for  the  molecular 
terms  in  the  Olstad  model  and  the  radiance  model  were  then 
modified  to  correct  for  the  LTNE  by  the  above  method.  The 
KCN  and  Anderson  models  had  no  molecular  terms  and  were, 
therefore,  left  unchanged.  The  equilibrium  and  actual 
degree  of  ionisation  and  degree  of  dissociation  were  found 
by  the  same  method  as  the  atomic  correction  factor  values. 
However,  the  a ’ s and  f3  ' s were  assumed  to  be  functions  of 
T^.  The  actual  degrees  of  ionization  and  dissociation  were 
found  by  the  method  outlined  in  the  previous  section.  It 
should  be  noted  that  the  computer  code  was  modified  so  that 
the  atomic  and  molecular  corrections  could  be  used 
independently  of  each  other,  or  not  at  all. 


RESULTS  AND  DISCUSSION 


The  National  Aeronautics  and  Space  Administration 

plans  to  test  the  concept  of  aerobraking  before  beginning 

the  construction  of  an  AOTV.  Consequently,  NASA  has 

proposed  the  use  of  an  aeroassisted  flight  experiment  (AFE) 

to  test  the  reliability  of  the  heat  shield  and  the  validity 

of  the  aerobraking  concept.  The  AFE  currently  being  studied 

by  NASA  is  a 60°  blunted  cone  that  is  approximately  two 

meters  in  diameter.  The  original  shock  shape  used  in  the 
7 

Grose  computer  code  was  modified  to  yield  an  axisymmetric 
body  that  approximated  that  of  the  AFE.  A ten  species, 
eleven  reaction  chemistry  model  (Table  2)  was  incorporated 


02  + M 20  + M 

N„  + M 2N  + M 

6 

N2  + 0 NO  + N 

N + 0„  NO  + 0 

6 

NO  + M N + 0 + M 

N + 0 N0+  + e" 

N + N N2  + e“ 

N + N N+  + e"  + N 

N + N+  2N+  + e" 

N + e“  N+  + 2e“ 

0 + M 0+  + e~  + M 


Table  2.  Chemical  Reaction  Model 
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into  the  Grose  code  by  Bobskill  . All  of  the  following 
results  were  obtained  from  the  modified  Grose  code  for  a 
velocity  of  ten  kilometers  per  second  at  an  altitude  of  80 
kilometers . 


Shock  Jump  Chemistry  Models 

The  addition  of  the  two  shock  jump  chemistry 
models  described  in  this  thesis  gave  a total  of  three  shock 
jump  conditions  in  the  modified  Grose  code.  The  first 
condition,  incorporated  by  Grose,  assumed  that  no  chemical 
reactions  take  place  over  the  shock  front.  The  second 
condition  assumed  that  diatomic  oxygen  dissociates  to  a 
state  of  equilibrium  with  the  local  temperature  at  the 
shock  front,  while  diatomic  nitrogen  remains  frozen.  The 
final  shock  jump  condition  assumed  that  both  diatomic 
oxygen  and  diatomic  nitrogen  were  in  equilibrium  with  the 
local  shock  front  temperature.  The  third  shock  jump 
condition  was  developed  in  this  thesis,  but  not  used  since 
it  was  felt  that  the  lower  speeds  of  the  AFE’s  flight 
regime  would  be  out  of  the  range  of  the  third  model’s 
region  of  applicability. 

In  order  to  keep  the  computational  effort 
reasonable,  the  flowfield  solution  method  was  only  applied 
out  to  a maximum  distance  of  10  centimeters  along  the 
shock.  and  the  flowfield  was  solved  along  individual 
streamlines  separated  by  a distance  of  0.5  centimeters. 
Solutions  were  obtained  using  both  the  first  shock  jump 
condition  for  a control,  and  the  second  to  study 
differences  in  chemistry  and  the  number  of  computational 
steps  needed  to  reach  X = 10  cm. 

As  Table  3 indicates,  the  use  of  the  oxygen 
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Computational 

Steps 

Condition 

Percentage 

Streaml ine 

1 

2 

Difference 

1 

808 

895 

10.77 

2 

718 

702 

- 2.23 

3 

514 

508 

- 1.  17 

4 

393 

373 

- 5.09 

5 

350 

334 

- 4.57 

6 

294 

327 

11. 22 

7 

234 

214 

- 8.55 

8 

206 

190 

- 7.77 

9 

191 

175 

- 8.38 

10 

177 

165 

- 6.78 

11 

150 

153 

2.00 

12 

115 

121 

5.  22 

13 

105 

84 

-20. 00 

14 

96 

74 

-22.92 

15 

84 

67 

-20. 24 

16 

74 

58 

-21. 62 

17 

66 

50 

-24. 24 

18 

57 

42 

-26. 32 

19 

41 

35 

-14.63 

Table  3.  Comparison  of  Computational  Steps  Taken 
by  Flowfield  Solution  Method  to  Reach 
X = 10  cm. 


equilibrium  model  yielded,  for  most  streamline,  substantial 
savings  in  the  number  of  computational  steps  required  to 
solve  the  flowfield.  Some  streamlines,  however,  had  an 
increase  in  the  number  of  steps  needed  for  solution  by  the 
oxygen  equilibrium  model.  Figures  2 and  3 compare  the  step 
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Condition  #2 


Condition  #1 


T 

/ 


sizes  taken  by  the  solution  method  along  streamlines  4 and 
6 (entering  the  shock  front  at  x = 1.5  cm.  and  x = 2.5 
respectively).  Streamline  4 had  a 5%  reduction  in  the 
number  of  computational  steps  needed  to  solve  for  the  flow 
properties  along  the  streamline.  Since  the  streamlines 
extend  to  an  x of  10  cm.  , it  can  be  seen  that  the  savings 
realized  by  using  the  oxygen  equilibrium  model  are  in  the 
nonequilibrium  region  immediately  behind  the  shock  front. 

In  contrast.  Figure  3 indicates  that  the  losses 
in  the  number  of  computational  steps  taken  to  calculate  the 
flow  properties  along  streamline  6 occur  further  downstream 
as  the  flow  is  approaching  equilibrium.  The  step  size 
increases  along  the  streamline  provided  the  chemical 
reactions  do  not  cause  the  enthalpy  to  exceed  the  initial 
value  by  a given  tolerance  internal  to  the  Grose  code.  It 
appears  that  the  oxygen  equilibrium  model  causes  a minor 
imbalance  in  the  enthalpy  of  some  streamlines  that  requires 
the  code  to  use  smaller  step  sizes  in  order  to  maintain 
constant  enthalpy.  This  effect  could  be  the  result  of  the 
tolerance  values  used  in  the  original  Grose  code;  but, 
unfortunately,  it  was  not  possible  to  investigate  what 
effect  a change  in  the  tolerance  values  would  have. 

In  Figure  4,  it  can  be  seen  that  the  heavy 
particle  temperature  of  the  flow  is  initially  lower  at  the 
shock  front  by  using  the  oxygen  equilibrium  model.  The 
lower  temperatures  are  the  result  of  the  dissociation 
process  "soaking  up"  much  of  the  flow’s  energy.  Downstream 
of  the  immediate  shock  front,  the  temperature  closely 
follows  the  temperature  of  the  frozen  shock  front  chemistry 
condition.  Similarly,  Figures  5 and  6 indicate  an 
over-dissociation  of  oxygen  at  the  shock  front.  The 
concentrations  of  atomic  and  diatomic  oxygen  quickly  resume 
the  frozen  chemistry  values  as  the  flow  reaches 
equilibrium.  Since  the  reaction  rate  of  oxygen 
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Condition  #1 


rate 


recombination  is  slower  than  the  rate  of  oxygen 
dissociation,  it  is  felt  that  the  initial  over-dissociation 
of  oxygen  allows  the  solution  method  to  take  larger 
computational  steps  in  the  nonequilibrium  region.  The 
larger  computational  step  sizes  would  not  be  possible  in 
the  nonequilibrium  region  were  it  oxygen  dissociation  - 
dominated. 


The  most  substantial  savings  in  the  number  of 
steps  taken  to  calculate  the  streamline  properties  were 
seen  in  the  streamlines  entering  the  shock  layer  further  up 
the  shock  front  where  most  of  the  flow  is  in  chemical 
nonequilibrium.  It  was  not  expected  that  the  oxygen 
equilibrium  model  would  result  in  any  savings  of 
computational  steps  in  the  equilibrium  region.  Such  savings 
were  only  expected  in  the  nonequilibrium  region,  and  the 
results  support  this  expectation. 


Electron  Temperature  Models 

After  the  two  electron  temperature  models  were 

incorporated  into  the  modified  Grose  code,  several  computer 

2 

runs  were  made  to  compare  the  Carlson  and  Rieper 

3 

correlation  with  the  Park  assumption.  In  Figure  7,  the 

Carlson  and  Rieper  correlation  is  displayed  for  a 

freestream  velocity  of  10  km. /sec  at  an  altitude  of  80  km. 

At  this  speed,  the  correlation  yields  the  expected  behavior 

for  the  T . The  electron  temperature  has  an  initial  sharp 

increase  at  the  shock  front  followed  by  an  almost  linear 

pattern  through  the  nonequilibrium  region  to  the 

equilibrium  region.  However,  the  correlation  fails  to  yield 

an  electron  temperature  that  matches  the  heavy  particle 

temperature  in  the  equilibrium  region.  It  is  also  felt  that 

the  values  of  T are  somewhat  low  for  the  AFE  flowfield  as 
® 18 

compared  to  the  results  of  others  . The  original  Carlson 
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and  Rieper  correlation  was  derived  at  a lower  velocity 

than  that  encountered  in  the  AFE’s  trajectory. 

In  order  to  give  a fairer  comparison,  the 

correlation  was  also  tested  at  a freestream  velocity  of  7.5 

km. /sec.  and  an  altitude  of  80  km.  The  results  are  plotted 

in  Figure  8.  Again,  the  correlation  gives  an  electron 

temperature  that  conforms  to  the  expected  pattern,  yet  at 

the  lower  speed,  the  correlation's  T matches  the  T.  in  the 

e n 

equilibrium  flow  region.  It  is  believed  that  the 

correlation  breaks  down  at  higher  freestream  velocities 
because  the  T is  dependant  on  the  number  density  of  N„.  At 
the  AFE  velocities,  little  Ng  is  left  in  the  flowfield,  and 
as  a consequence,  the  correlation  breaks  down  in  the  10 
km. /sec.  case. 

The  Park  assumption,  where  T = T VT  , was  also 

e vN2 

tested  at  a freestream  velocity  of  10  km. /sec.  using  the 

CVDV  and  CPL  vibrational  - dissociation  coupling  models. 

The  results  are  plotted  in  Figures  9 and  10.  The  CVDV  model 

gives  an  initially  high  electron  temperature  peak  near  the 

shock  front  followed  by  a decrease  that  approaches  the  T^ 

in  the  equilibrium  region  of  the  flow.  The  CPL  model  yields 

similar  results,  yet  with  a less  severe  Tg  peak  near  the 

shock  front.  The  CVDV  model's  high  initial  vibrational 

temperature  for  diatomic  nitrogen  is  not  believed  to  be 

reflective  of  the  actual  behavior  of  the  T and  could  lead 

e 

to  excessive  radiative  heating  from  the  region  near  the 
shock  front  in  the  case  of  a highly  transparent  shock 
layer,  as  shall  be  seen  in  the  next  section.  It  is 
therefore  felt  that  the  Park  assumption  combined  with  the 
CPL  vibration  - dissociation  coupling  model  yields  the  best 
results  for  electron  temperature  of  the  two  Tg  models 
tested. 
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Figure  8.  Carlson  and  Rieper  T Correlation  at  7.5  km.  /se 

e 

for  Streamline  4. 
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Figure  9.  Park  Assumption  Tg  at  10  km. /sec.  for  Str 
4 with  CVDV  Vibration-Dissociation  Coupl 
Model. 
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Figure  10.  Park  Assumption  T at  10  km. /sec.  for  Streamline 

e 

4 with  CPL  Vibration-Dissociation  Coupling 
Model. 
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Radiative  Heat  Transfer  Models  and  Nonequi 1 ibrium 
Correction  Factors 

The  radiative  heat  transfer  and  the 
nonequilibrium  correction  factors  are  both  highly  dependent 
on  the  selected  chemical  reaction  rates  as  well  as  the 
vibration  - dissociation  model.  Several  options  were 

Q 

available  with  the  modified  Grose  code  . In  addition  to  the 
CVDV  and  CPL  vibration  - dissociation  models,  it  was 
possible  to  choose  for  the  electron  impact  reaction, 

N + e"  < - N+  + 2e“ 

19 

the  chemical  rate  postulated  by  Kang  and  Dunn  , the  Wilson 
20  21 

rate  used  by  Carlson  , or  the  chemical  rate  proposed  by 

22 

the  Sandia  National  Laboratory  . The  Kang  and  Dunn  rate  is 
approximately  an  order  of  magnitude  faster  than  the  Wilson 
rate,  and  the  Wilson  rate  is,  in  turn,  an  order  of 

magnitude  faster  than  the  Sandia  rate.  Thus,  there  were 
several  combinations  of  the  above  chemical  rates,  vibration 
- dissociation  coupling  models,  and  nonequilibrium 
correction  factors  available  in  the  modified  Grose  code. 
All  temperature,  species  number  . density,  and  correction 
factors  were  calculated  and  saved  during  the  solution  of 
the  flowfield.  The  surface  radiative  heat  transfer  was  then 
calculated  along  the  body  out  to  an  x of  9.5  cm.  For 
simplicity,  results  will  only  be  presented  at  the  location 
corresponding  to  9.0  cm.  along  the  shock  front.  In  all 
cases,  the  electron  temperatures  used  in  this  part  of  the 
study  followed  the  Park  assumption  that  Tg  = ^v^2-  The 

electron  temperatures  and  the  number  densities  of  N and  N+ 
are  plotted  against  their  distance  from  the  shock  front  to 
the  vehicle  wall  in  Figures  11  - 19. 

By  inspection  of  Figures  11  - 


13,  it  can  be  seen 
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Figure  11.  Comparison  of 
at  X=9 .0  cm. 
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Figure  12:  Comparison  of  Tq  for  Kang  and  Dunn  Reaction 
Rate  at  X=9.0  cm. 
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Figure  13.  Compari: 
at  X=9. 
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that  the  CPL  model  consistently  gives  lower  electron 
temperatures  than  the  CVDV  models.  As  was  stated  earlier, it 
is  felt  that  the  actual  behavior  of  the  electron 
temperature  is  best  modelled  by  the  CPL  model.  The  high  T 

0 

near  the  shock  front  in  the  CVDV  model  could  lead  to  an 
over-estimate  of  the  radiative  heat  transfer.  On  the  other 
hand,  the  CPL  model  yields  fairly  consistent  results  for  T 

e 

regardless  of  the  chemical  rates  chosen. 

The  number  densities  of  atomic  nitrogen  for  the 
Wilson  and  Sandia  rates  are  fairly  consistent  with  one 
another;  and  the  CVDV  model  yields  a larger  concentration 
of  N than  the  CPL  model  for  both  rates.  However,  the  Kang 
and  Dunn  rate  yields  a higher  initial  rate  of  ionisation  of 
nitrogen  relative  to  the  other  chemical  rates.  It  should  be 
noted  that  in  the  original  formulation  of  the  Wilson  rate 
the  ionization  of  atomic  nitrogen  was  a two  step  process. 
The  first  step  raised  the  atomic  nitrogen  to  an  excited 
state,  while  the  second  step  involved  rapid  ionisation.  The 
first  reaction  step  in  this  process  is  included  in  the 
chemistry  model  of  the  modified  Grose  code,  while  the 
second  is  not  specifically  accounted  for.  The  Kang  and  Dunn 
reaction  rate,  on  the  other  hand,  represents  the  ionisation 
of  nitrogen  in  a one-  step  process;  and  thus,  this  process 
is  accounted  for  in  the  modified  Grose  code's  chemistry 
model.  The  combination  of  the  Kang  and  Dunn  rate  with  the 
CVDV  vibration  - dissociation  coupling  model  predicts  a 
very  high  concentration  of  N+  and  a lower  concentration  of 
N relative  to  the  other  chemical  rates  and  coupling  models. 
The  number  densities  of  N+  predicted  by  the  Wilson  and 
Sandia  rates  are  also  fairly  consistent  with  one  another, 
except  that  the  Wilson  rate  predicts  a lower  N+  number 
density  with  the  CPL  model  than  are  present  at  any  other 
rate  or  coupling  model. 

The  differences  in  the  radiative 


heat  transfer 
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predicted  between  the  coupling  models  and  chemical  rates 
can  be  seen  in  Tables  4-7.  The  uncorrected  radiative  heat 
transfer  models  yield  predictions  that  are  clearly  too 
large  and  conflict  with  those  obtained  in  the  accurate,  yet 

more  time  consuming,  Direct  Simulation  Monte  Carlo  (DSMC) 

18  15 

method  , or  in  experimental  shock  tube  results  . As  a 

consequence,  it  is  felt  that  the  uncorrected  radiative  heat 

transfer  models  should  be  disregarded.  The  data  obtained 

from  the  radiative  heat  transfer  model  with  the  atomic 

correction  factors  alone  similarly  predicts  too  high  of  a 

radiative  flux  to  the  wall  and  should  also  be  viewed  with 

some  suspicion. 

It  is  interesting  to  note  that  the  early 
ionization  of  nitrogen  predicted  by  the  Kang  and  Dunn 
electron  impact  rate  consistently  yields  a lower  radiative 
flux  than  the  Wilson  rate  when  uncorrected.  However,  when 
corrected,  Kang  and  Dunn  leads  to  a higher  radiative  flux 
than  the  Wilson  rate.  Figures  20  - 23  display  the 

correction  factors  for  the  nitrogen  terms;  and  as  can  be 
observed,  the  correction  factors  for  atomic  nitrogen  with 
the  Kang  and  Dunn  rate  are  often  greater  than  one.  This 
fact  accounts  for  the  higher  radiative  heat  transfer  with 
the  Kang  and  Dunn  ionization  rate.  The  high  degree  of 
ionisation  from  the  Kang  and  Dunn  rate  leads  to  a 

corresponding  increase  in  the  number  of  atoms  in  the 
excited  state,  and  consequently,  radiative  flux  associated 
with  the  photo-deionisation  from  the  excited  nitrogen.  If 
the  chemistry  model  included  the  second  step  of  the 

ionization  process  used  by  Wilson,  it  is  possible  that  the 
Wilson  rate  predictions  would  correspond  to  the  results 
yielded  by  the  Kang  and  Dunn  rate.  Since  the  Kang  and  Dunn 
rate  inherently  take  the  two  steps  of  the  ionisation 

process  into  account,  it  is  felt  that  the  Kang  and  Dunn 

rate  yields  the  most  accurate  results  given  the  chemistry 
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Radiative  Heat  Transfer 


(Watts/cm. ^ ) 


Model /Band 

Uncorrected 

Atomic 

Corrections 

Atomic  & 

Molecular 

Corrections 

Olstad 

1 

9.8 

8.6 

0.  09 

2 

1059.0 

434.  0 

0.  05 

3 

3691.  0 

838. 0 

0.  15 

4 

894.0 

25.7 

0.  06 

5 

2938. 0 

2715. 0 

0.  02 

6 

8040.  0 

4703.0 

0.  35 

7 

0.  03 

0.  03 

0.  03 

8 

1838. 0 

1415.0 

0.  16 

Total 

18470. 0 

10140. 0 

0.  91 

KCN 

1 

10.  7 

5.  44 

5. 44 

2 

241.5 

0.06 

0.  06 

3 

3054.  0 

2. 32 

2.32 

4 

918.0 

0.  02 

0.  02 

5 

284.  0 

0.  15 

0.  15 

Total 

4510. 0 

7.99 

7.99 

Radiance 

1 

0.  01 

0.  01 

0.  01 

2 

0.  79 

0.  79 

0.  79 

3 

0.  49 

0.  49 

0.  49 

4 

0. 2E-4 

0. 2E-4 

0.  2E-4 

5 

0. 3E-17 

0. 3E-17 

0.  3E-17 

6 

0. 3E-17 

0. 3E-17 

0.  3E-17 

7 

349.9 

0.  02 

0.  02 

8 

2860.  0 

39.6 

39.6 

9 

358.6 

0.  02 

0.  02 

10 

1269.0 

8.9 

8.9 

11 

0. IE-15 

0.  IE-15 

0.  IE-15 

12 

0. IE-15 

0. IE-15 

0. IE- 15 

13 

23. 0 

23.0 

'0.  4E-3 

Total 

4863. 0 

72.8 

49.78 

Anderson 

1 

8022. 0 

0.  38 

0.  38 

2 

104800. 0 

0. 3E-2 

0.  3E-2 

Total 

112800. 0 

0.  39 

0.  39 

Qr  for  Wilson  Rate  and  CVDV  Coupling  Model  at 
X=9 . 0 cm. 
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Table  4. 


o 

Radiative  Heat  Transfer  (Watts/cm.  ) 


Model /Band 

Uncorrected 

Atomic 

Corrections 

Atomic  & 

Molecular 

Corrections 

01st  ad 

1 

0.  17 

0.  10 

0.  05 

2 

7.3 

4.5 

0.  13 

3 

15. 8 

8.  1 

0.  02 

4 

3.9 

0.  50 

0.  9E-2 

5 

84.  7 

83.2 

0.  03 

6 

43.6 

24.  7 

0.  55 

7 

0.  02 

0.  02 

0.  02 

8 

67. 0 

61.0 

0.  36 

Total 

222. 4 

182.  1 

1.  17 

KCN 

1 

6.5 

1.  21 

1.  21 

2 

2.  1 

0.01 

0.01 

3 

90.  4 

0.  01 

0.  01 

4 

0.  9 

0.2E-2 

0.  2E-2 

5 

4.  5 

0.  03 

0.  03 

Total 

104.  4 

1. 27 

1.27 

Radiance 

1 

0. 4E-2 

0.  4E-2 

0. 4E-2 

2 

0.  14 

0.  14 

0.  14 

3 

0.  11 

0.  11 

0.  11 

4 

0. 3E-4 

0.  3E-4 

0. 3E-4 

5 

0. 9E-18 

0.  9E-18 

0. 9E-18 

6 

0. IE-17 

0.  IE-17 

0. IE-17 

7 

1. 33 

0.  3E-2 

0. 3E-2 

8 

595.2 

28.9 

28.9 

9 

2.27 

0.  09 

0.  09 

10 

278.3 

263.5 

263.5 

11 

0.  7E-16 

0.  7E-16 

0. 7E-16 

12 

0. IE- 15 

0.  IE-15 

0. IE- 15 

13 

10.  9 

10.  9 

0. 8E-4 

Total 

888.2 

303.6 

292.7 

Anderson 

1 

53. 0 

0.  05 

0.  05 

2 

424.  4 

0.  4E-4 

0. 4E-4 

Total 

477.5 

0.  05 

0.  05 

Qr  for  Wilson  Rate  and  CPL  Coupling  Model  at 
X=9 .0  cm. 
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Radiative  Heat  Transfer 


(Watts/cm. ^ ) 


Mod el /Band 

Uncorrected 

Atomic 

Corrections 

Atomic  &. 

Molecular 

Corrections 

Olstad 

1 

0.  38 

0.  55 

2.82 

2 

88.27 

66.  11 

0.  79 

3 

146.  9 

137.  1 

4.  88 

4 

11. 36 

8.7 

2.39 

5 

744.  1 

732. 0 

0.  61 

6 

685.3 

559.4 

11. 2 

7 

0.  05 

0.  04 

0.  04 

8 

351. 0 

334.  2 

6. 06 

Total 

2027.0 

1838.0 

29.23 

KCN 

1 

8.71 

29.9 

29. 9 

2 

1. 77 

2.49 

2.49 

3 

33. 77 

30.  26 

30.  26 

4 

2.11 

0.58 

0.  58 

5 

2.65 

6.51 

6.  51 

Total 

49. 01 

69.75 

69.75 

Radiance 

1 

0.  02 

0.  02 

0.  02 

2 

0.50 

0.  50 

0.  50 

3 

0.  44 

0.  44 

0.  44 

4 

0.7E-4 

0.7E-4 

0.  7E-4 

5 

0. 9E-18 

0. 9E-18 

0. 9E-18 

6 

0. IE-17 

0. IE-17 

0. IE-17 

7 

2.0 

0.  87 

0.  87 

8 

296. 4 

2760. 0 

2760.0 

9 

34.  45 

0. IE-2 

0. IE-2 

10 

416.8 

1.76 

1.76 

11 

0. 6E-15 

0. 6E-15 

0. 6E-15 

12 

0. 3E-15 

0. 3E-15 

0. 3E-15 

13 

0.  05 

0.  05 

0. IE-4 

Total 

750.  6 

2764. 0 

2764.0 

Anderson 

- 

1 

853.5 

72. 53 

72.  53 

2 

15880. 0 

259.6 

259.6 

Total 

16740. 0 

332.  1 

332.1 

Table  6. 

Q 

r 

for 

Kang  and  Dunn 

Rate  and  CVDV 

Coupling  Model 

a*t 

X=9. 

. 0 cm. 
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Radiative  Heat  Transfer  (Watts/cm. 


Model/Band 

Kang  & Dunn 
Rate 

CPL  Model 

Sand i a 
Rate 

CVDV  Model 

CPL  Model 

Olstad  . 

1 

0.  40 

0.02 

0.  06 

2 

0.  18 

0.  03 

0.  13 

3 

0.  60 

0.  02 

0.  04 

4 

0.  28 

0.  07 

0.  02 

5 

0.  09 

0.01 

0.  03 

6 

2.09 

0.  11 

0.  58 

7 

0.  03 

0.  03 

0.  02 

8 

1. 45 

0.  04 

0.  38 

Total 

5.  13 

0.26 

1.26 

KCN 

1 

20.75 

0.46 

1.64 

2 

0.38 

0.05 

0.02 

3 

0.65 

0.31 

0.  04 

4 

0.07 

0. 2E-2 

0. 4E-2 

5 

1.20 

0.01 

0.  07 

Total 

23.05 

0.  80 

1.78 

Radiance 

1 

0.  01 

0. 7E-2 

0.  5E-2- 

2 

0.  30 

0.  28 

0.  15 

3 

0.  25 

0.20 

0.  12 

4 

0.6E-4 

0. 9E-5 

0. 3E-4 

5 

0.8E-18 

0. 3E-17 

0. 9E-18 

6 

0. IE-17 

0.  3E-17 

0. IE-17 

7 

0.  10 

0.  2E-2 

0. 6E-2 

8 

1187.0 

2.25 

59.34 

9 

0.07 

0.02 

0.  09 

10 

258.  7 

5.77 

257.4 

11 

0. 2E-15 

0.  7E-16 

0. 9E-16 

12 

0.  2E-15 

0.  8E-16 

0. IE-15 

13 

0.  2E-4 

0.  IE-2 

0. 7E-4 

Total 

1447.0 

8.52 

317.  1 

Anderson 

1 

2.  23 

0.  04 

0.  11 

2 

0.  6E-3 

0. 2E-3 

0. 3E-3 

Total 

2.  23 

0.  04 

0.  11 

Table  7.  with  Atomic  and  Molecular  Correction  Factors 
at  X=9 .0  cm. 


e from  Shock  (cm.) 

orrection  Factors  for  Wilson  Rate 


Coupling. 


Distance  from  Shock  (cm.) 


Figure  22.  Nitrogen  Correction  Factors  for  Kang  and 
Dunn  Rate  with  CVDV  Coupling. 


Correction  Factor 


Distance  from  Shock  (cm.) 

Figure  23.  Nitrogen  Correction  Factors  for  Kang  and 
Dunn  Rate;  with  CPL  Coupling 


model  used  in  the  modified  Grose  code. 

Unfortunately,  the  Anderson  model,  while  simple, 
predicts  values  of  radiative  flux  that  are  not  in  agreement 
with  the  other  step  models.  Apparently,  two  steps  are 
insufficient  to  properly  describe  the  radiative  processes 
in  the  AFE  flight  regime,  particularly  when  nonequilibrium 
effects  are  important. 

The  radiance  model  consistently  predicts 
radiative  heat  transfers  greater  than  those  of  the  various 
step  models.  Since  the  density  of  the  air  at  80  km.  is  high 
enough  that  a large  amount  of  self-  absorption  should  take 
place,  the  radiance  model,  being  a transparent  gas  model, 
is  believed  to  also  be  inappropriate  for  the  AFE  flight 
regime. 

If  the  integral  in  equation  (66)  for  the 
radiative  heat  transfer  to  the  wall  is  represented  as  the 
summation  over  the  code  points  between  the  shock  and  the 
wall. 


!r  = 1 i9r 


(94) 


it  can  be  seen  on  Figure  24  that  the  high  initial  Tg 
predicted  by  the  uncorrected  CVDV,  model  leads  to  the  large 
predicted  radiative  heat  transfer  to  the  wall  in  the 
optically  thin  shock  layer  at  80  km.  altitude.  The  large 
correction  factors  calculated  for  the  Kang  and  Dunn  rate 
with  a corrected  CVDV  coupling  model  combined  with  the  high 
peak  T^  predicted  behind  the  shock  front,  leads  to  a large 
amount  of  the  wall  radiative  transfer  originating  from  the 
gas  close  to  the  shock  as  seen  in  Figure  25.  By  contrast, 
Figure  26  shows  that  the  wall  radiative  heat  transfer 
predicted  by  the  corrected  CPL  model  using  the  Kang  and 
Dunn  rate  primarily  comes  from  the  region  close  to  the  AFE 
body.  Since  the  actual  electron  temperature  is  believed  to 


Delta  Qr  at  Wall  (Watts  x cm  — 2) 


Distance  from 

'igure  25.  Incremental  Radiative  H 
from  Corrected  CVDV  Mod 
Rate  at  X = 9.0  cm. 


Delta  Qr  at  Wall  (Watts  x cm  — 2) 


have  a lower  initial  increase  and  peak  similar  to  that 
displayed  by  the  CPL  model,  it  is  felt  that  the  CPL  model 
should  provide  a more  accurate  prediction  of  the  radiative 
heat  transfer  than  the  other  models. 

The  final  problem  then,  is  to  choose  between  the 
Olstad  and  the  KCN  models  for  the  more  accurate  radiative 
transfer  model.  While  KCN  and  Olstad  agree  in  the  visible 
and  infrared,  they  disagree  in  the  vacuum  ultraviolet, 
primarily  due  to  choices  of  band  widths.  Since  Olstad  has 
band  widths  based  upon  the  actual  ionization  edges  of 
oxygen  and  nitrogen,  it  is  probably  the  better  of  the  two. 
In  addition,  the  KCN  model  was  originally  derived  for 
atomic  nitrogen  and  correlated  to  air,  and  Table  7 shows 
that  there  is  significant  molecular  radiation  that  is  not 
taken  into  account  by  the  KCN  model.  Further,  Figures  20 
23  indicate  by  the  size  of  the  molecular  correction  factors 
that  there  is  a considerable  LTNE  effect  present  in  the  AFE 
flowfield.  Consequently,  the  most  accurate  combination  of 
the  various  radiative  models,  chemical  rates,  and  vibration 
- dissociation  coupling  models  is  belived  to  be  the  Olstad 
model  with  molecular  and  atomic  correction  factors  using 
the  Kang  and  Dunn  chemical  reaction  rates  with  CPL 
modelling.  However,  for  a conservative  estimate,  it  is 
suggested  that  the  Kang  and  Dunn  reaction  rates,  combined 
with  the  Olstad  and  CVDV  models,  would  provide  a reliable 
"worst  case"  estimate. 


CONCLUSION 


The  shock  jump  chemistry  models  developed  in  this 
thesis  yielded  accurate  results  for  the  AFE  flowfields 
investigated  and  increased  the  computational  speed  of  the 
modified  Grose  code.  However,  the  internal  tolerances  of 
the  Grose  code  need  further  investigation  in  order  to 
determine  why  several  streamlines  required  more 
computational  steps  to  obtain  a solution  with  the  oxygen 
equilibrium  dissociation  model  than  with  frozen  chemistry 
at  the  shock  front.  In  addition,  the  nitrogen  and  oxygen 
equilibrium  model  needs  to  be  investigated  at  higher 
freestream  velocities  than  those  associated  with  the  AFE 
trajectory. 

The  assumption  that  Tg  = T^z  yielded  the  pattern 
expected  for  the  electron  temperature  when  used  with  the 
CPL  vibration  - dissociation  coupling  model.  However,  the 
assumption  resulted  in  high  electron  temperatures  near  the 
shock  front  when  used  with  the  CVDV  vibration  - 
dissociation  coupling  model.  The  Carlson  and  Rieper 
correlation  yielded  reliable  electron  temperatures  at  low 
freestream  velocities,  but  gave  results  that  were  too  low 
at  the  AFE  flight  conditions.  If  the  Carlson  and  Rieper 
correlation  could  be  modified  to  account  for  the  low  number 
density  of  diatomic  nitrogen  in  the  AFE  flowfield,  it  is 
believed  that  the  correlation  would  give  fast  and  accurate 
results  for  the  AFE  flight  regime. 

The  radiative  heat  transfer  was  found  to  be 
highly  dependent  on  the  chemical  reaction  rates,  vibration 
- dissociation  coupling  model,  and  the  correction  factors 
used.  The  best  results  were  obtained  with  the  Kang  and  Dunn 
electron  impact  ionisation  rates  with  CPL  coupling'  and  both 
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atomic  and  molecular  correction  factors  included.  The 
radiance  model  was  found  to  yield  radiative  heat  transfers 
that  were  too  high  since  there  was  significant  self- 
absorption in  the  AFE  flowfield  and  the  transparent  gas 
assumption  is  inaccurate.  The  Anderson  model  was  originally 
derived  for  electron  temperatures  that  were  well  below 
those  present  throughout  most  of  the  AFE' s flowfield  and  is 
believed  to  be  inadequate  for  the  present  conditions  of 
interest.  The  KCN  model  yielded  results  similar  to  the 
Olstad  model;  yet  the  KCN  model  was  derived  for  atomic 
nitrogen,  and  it  was  felt  that  the  Olstad  model  more 
accurately  captured  the  effects  of  atomic  and  molecular 
band  radiation.  However,  the  radiative  cross-  sections  for 
vacuum  ultraviolet  line  regions  in  the  Olstad  model  need  to 
be  refined  for  the  higher  altitudes  of  the  AFE  flight 
regime. 

The  LTNE  correction  factors  in  this  thesis  helped 

to  adapt  the  radiative  heat  transfer  models  to  the  AFE 

flight  regime,  and  the  results  yielded  by  the  radiation 

models  using  the  correction  factors  corresponded  to  those 

3 18 

obtained  by  other  methods'  ’ . However,  the  assumption  in 

the  derivation  of  the  molecular  correction  factors  that  the 
upper  electronic  levels  of  Ng  are.  populated  in  equilibrium 
with  atomic  nitrogen  needs  further  validation. 

In  conclusion,  various  engineering  models  of 
several  important  aspects  of  the  hypersonic  flow  about  an 
AFE/AOTV  type  of  vehicle  have  then  been  investigated.  Based 
on  these  studies,  it  is  believed  that  accurate  flowfield 
and  radiative  heating  results  can  be  obtained  by  using 
together,  the  eight  step  Olstad  absorption  coefficient 
model,  molecular  and  atomic  correction  factors,  the  Kang 
and  Dunn  electron  impact  nitrogen  ionisation  rate 
expression,  and  the  CPL  vibration  - dissociation  coupling 
model.  For  a conservative  estimate,  the  CPL  model  could  be 

1^3 


replaced  with  the  CVDV  model  to  obtain  reliable 
case"  estimates. 


"worst 
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APPENDIX  5 


Program  RAPROX 

An  Approximate  Solution  for  Hypervelocity,  Nonequilibrium  Radiating,  Reacting, 

and  Conducting  Stagnation  Regions 

Developed  by 
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***********  PROGRAM  RAPROX  ********** 


Program  RAPROX  is  an  easily  used  and  rapid  computer  program  designed  to 
provide  approximate  stagnation  point  solutions  tor  flowfield  structure  and 
estimates  of  radiative  transfer  for  hypervelocity  vehicles  in  the  flight  regime  of 
11-18  km/sec.  It  includes  the  effects  of  chemical  and  thermal  nonequilibrium  and 
nonequilibrium  nongray  radiative  transfer.  It  is  valid  only  when  the  flowfield  is 
dominated  by  atomic  and  ionization  processes  and  dissociation  can  be  reasonably 
assumed  to  be  "complete"  in  the  shock  front. 

The  program  is  based  upon  the  theory  presented  in  AIAA  Paper  No.  88-2672. 
However,  some  minor  changes  have  been  incorporated  into  the  program  since  the 
publication  of  that  paper.  The  radiation  losses  from  the  flowfield  are  still 
estimated  using  using  specific  bands  of  the  5-step  model  referenced.  It  is 
believed  that  this  approach  will  give  reasonable  estimates  of  the  losses. 
However,  the  radiative  heating  to  the  wall  is  now  computed  only  with  a modified 
version  of  the  Olstad  8-step  model.  The  original  Olstad  model  has  been 
simplified  to  only  include  nitrogen  atom  radiation.  Also,  the  cross-sections  for 
the  1130-1801  Angstrom  wavelength  region  have  been  reduced  by  a factor  of  2.5. 
This  region  was  denoted  as  bands  five  and  six  in  the  Olstad  model  and  was 
renumbered  as  bands  six  and  seven  in  the  AIAA  paper.  In  addition,  correlations 
for  the  adiabatic  shock  standoff  distance  and  the  chemical  relaxation  length  have 
been  built  into  the  program  as  well  as  a routine  to  predict  the  theoretical 
equilibrium  conditions.  These  changes  simplify  the  usage  of  the  code.. 

The  program  is  written  in  Microsoft  BASIC  and  is  designed  to  operate  on  an  AT 
compatible  microcomputer  under  the  Microsoft  QuickBasic  Compiler.  (Note:  The 
word  "AT"  may  be  a registered  trademark  of  the  IBM  Corporation.  The  word 
"QuickBasic"  is  a registered  trademark  and  a copyrighted  computer  software 
program  from  the  Microsoft  Corporation.)  In  its  present  form  it  cannot  be 
operated  under  standard  BASICA  or  GWBASIC  since  it  contains  many  lines  without 
statement  numbers.  However,  the  program  could  be  easily  modified  for  operation 
under  these  systems.  The  program  also  generates  a graphical  output  and  requires 
at  least  a CGA  color  graphics  compatible  system.  While  some  of  the  output  is  in 
color,  it  could  be  viewed  using  a compatible  monochrome  system. 

All  output  from  the  program  is  either  to  the  screen  or  to  files  on  the  drive 
where  the  program  is  located.  The  files  consist  of  a flowfield  output  file 
assigned  a name  selected  by  the  user  (for  example  SAMP),  a summary  and  heat 
transfer  data  file  denoted  by  *.HT  (example  SAMP.HT),  two  data  files  suitable  for 
use  with  an  external  graphics  program  designated  #.Pi  and  *.P2,  and  a plot  image 
file  *.BAS  where  * is  an  input  name  from  the  user  (example  SAMPP.BAS).  The  plot 
image  file  shoud  be  retrievable  using  the  program  PLOTPIC.BAS.  The  latter  is 
listed  in  this  appendix.  Due  to  differences  in  systems,  the  external  graphics 
packages  for  making  plots  from  data  has  to  be  supplied  by  the  user.  Depending 
upon  the  packages  used,  the  output  data  files  #.Pi  and  *.P2  format(s)  may  have  to 
be  modified. 
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USER  INSTRUCTIONS 


In  general  RAPROX  is  a user  oriented  program  and  simple  to  use.  The  sample 
case  contained  in  this  appendix  corresponds  to  the  -following  input  conditions: 
Freestream  velocity  16  km/sec,  Altitude  o-f  75  km  with  a freestream  pressure  o-f 
24.897  dynes/sq  cm  and  a temperature  of  200.15  K,  Nose  radius  of  230  cm.  In 
these  instructions  it  will  be  assumed  that  the  user  has  installed  the  program 
under  QuickBasic  and  knows  how  to  run  the  program  under  QuickBasic. 

After  giving  the  command  to  "Run"  and  "Start",  the  user  will  interactively  be 
asked  "U  INFINITY  IN  KM/SEC  IS  Enter  16  followed  by  return.  Next  "P 
INFINITY  IN  DYNES/SQ  CM  IS?"  will  appear.  Enter  24.897  (Return).  This  will  be 
followed  by  "T  INFINITY  IN  DEG  K IS  ?"  Input  200.15  (return).  Subsequently  the 
nose  radius  will  be  requested  via  "NOSE  RADIUS  IN  CM  IS  ?".  For  the  sample 
case  enter  230.  • 

At  this  point  there  will  appear  on  the  screen  the  iteration  history  of  the 
routine  which  computes  the  ideal  equilibrium  conditions  corresponding  to  this 
case.  These  conditions  assume  complete  dissociation.  On  the  screen  will  appear 
values  for  E2,  the  ideal  equilibrium  degree  of  ionization,  and  T2,  the 
corresponding  equilibrium  temperature.  For  the  sample  cases  the  values  are  E2 
= 0.627  and  T2  = 13053. 

Next  the  code  will  request  values  for  IM  and  DTAU.  IM  is  the  maximum 
number  of  grid  points  to  be  used  in  both  the  thick  and  the  thin  regions.  At 
present  the  code  is  dimensioned  for  maximum  value  of  IM  of  100.  Typical 
practical  values  of  IM  are  50  and  100.  For  the  sample  case  enter  100.  DTAU  is 
the  increment  to  be  used  in  the  thick  region.  Appropriate  values  have  to  be 
selected  fundamentally  on  experience.  However,  a little  later  the  code  will  make 
an  estimate  of  an  appropriate  DTAU  and  the  user  will  have  an  opportunity  to 
change  the  initially  selected  value.  The  "criterion"  for  an  appropriate  value  is 
that  in  the  final  solution,  the  thick  nonequilibrium  region  transitions  "smoothly" 
into  the  thin  equilibrium  zone.  If  DTAU  is  selected  too  large,  the  thick  zone  may 
exceed  the  shock  layer  thickness  or,  more  commonly,  have  a long  tail  of  constant 
properties.  If  DTAU  is  too  small,  the  thick  zone  behind  the  shock  will  be  short 
and  the  transition  to  the  equilibrium  thin  region  will  be  marked  by  a sharp  jump  or 
discontinuity.  For  initial  cases,  the  user  will  probably  have  to  run  a case  a few 
times  with  various  values  of  DTAU  until  he/she  is  "comfortable"  physically  with 
the  results.  For  the  sample  case  enter  for  DTAU  a value  of  0.075.  Thus  the  IM 
and  DTAU  input  should  be  100, .075  followed  by  a return. 

Next  the  user  will  be  asked  to  supply  a plot  name.  For  the  sample  case  use 
SAMPP.  The  additional  P at  the  end  of  the  name  is  suggested  as  an  indicator  that 
the  file  is  a plot  file.  This  input  will  be  followed  by  a request  for  a name  for  an 
OUTPUT  file.  For  the  sample  case  use  SAMP. 

At  this  point  the  names  and  values  for  fifteen  variables  will  appear  on  the 
screen,  and  the  user  will  asked  whether  or  not  these  are  acceptable.  These 
variables  are  Ul,  the  freestream  velocity  in  cm/sec;  Pi,  the  freestream  pressure; 
T2,  the  computed  equilibrium  temperature;  E2,  the  computed  equilibrium  degree  of 
ionization;  Si,S2,  Bi,  B2,  computed  radiative  cross  sections  and  source  functions 


used  to  compute  cooling  in  the  thick  and  thin  zones;  XR»  the  computed  estimated 
chemical  relaxation  distance;  L,  the  shock  standoff  distance  corresponding  to  the 
■fully  dissociated  nonreacting  nonradiating  case;  N,  an  exponent  used  in  the 
radiation  term  in  the  thin  region;  Tl,  the  -freestream  temperature;  TW,  the  wall 
temperature;  PLOT  TMAX,  the  maximum  temperature  ordinate  -for  the  screen  plot 
when  the  computation  is  -finished;  and  PLOT  EPS  MAX,  the  maximum  ordinate  -for 
degree  o-f  ionization  -for  the  screen  plot.  In  general*  variables  5 - 11  would  not  be 
changed  and  are  simply  presented  -for  information  purposes.  Variables  i,  2,  and 
12  might  be  changed  if  they  were  inputted  incorrectly  at  the  beginning.  Variables 
14  and  15  might  be  changed  at  the  user's  discretion  to  make  the  final  screen  plot 
more  desirable.  However*  in  general,  the  variable  most  likely  to  be  changed  is 
number  13,  TW,  the  wall  temperature;  but  it  should  be  remembered  that  TW  should 
be  relatively  high  since  the  model  assumes  that  the  gas  is  composed  only  of 
atoms,  ions,  and  electrons  (no  molecules).  Also,  if  U1  is  changed,  remember  that 
at  this  point  it  must  be  input  in  units  of  cm/sec,  not  km/sec. 

If  the  user  desires  at  this  point  to  chanae  a variable,  enter  N followed  by 
return.  The  user  then  will  asked  "WHICH  ONE  SHOULD  BE  CHANGED?"  Enter  the 
number  of  the  variable  which  is  to  be  changed.  Then,  when  prompted,  enter  the 
new  value  for  the  variable.  The  new  values  will  then  be  displayed.  Note  that  if 
freestream  conditions  are  changed  that  the  values  for  T2  and  E2  are  not  chancied. 
(Ideally  they  should  be,  but  the  code  has  not  been  modified  to  do  this.)  When  the 
user  is  satisfied  with  the  values,  input  Y (for  yes)  followed  by  return. 

At  this  point  a Reynolds  number  based  upon  conditions  behind  the  shock  and 
the  reference  length  will  appear  followed  by  an  estimate  for  DTAU  and  an  inquiry 
concerning  whether  or  not  the  user  wishes  to  change  DTAU.  For  the  sample  case 
the  suggested  the  value  is  0.08  which  is  quite  close  to  the  inputed  value  of  0.075. 
Thus,  N for  no  change. 

At  this  point  the  actual  flowfield  solution  will  be  computed  and  some  numbers 
will  appear  and  scroll  on  the  screen.  These  numbers  are  associated  with  the 
iterative  thin  solution  and  simply  indicate  that  the  program  is  working.  After  the 
flowfield  solution  is  obtained,  it  will  be  written  to  the  appropriate  output  file, 
and  a graphical  plot  of  the  temperature  and  degree  of  ionization  will  appear  on 
the  screen.  At  the  top  of  the  screen  also  will  appear  the  estimated  convective 
heating. 

On  the  plot,  the  shock  front  is  on  the  left  whle  the  wall  is  on  the  right.  The 
red  line  is  temperature  and  its  scale,  running  from  0 to  TMAX,  is  on  the  left.  The 
green  line  is  the  degree  of  ionization  and  its  scale,  running  from  0 to  EPS  MAX  is 
on  the  right.  The  temperature  in  the  thick  chemical  nonequilibrium  zone  is  plotted 
as  a solid  line,  while  that  for  the  thin  equilibrium  zone  is  plotted  with  dots  for 
each  point.  However,  sometimes  the  dots  are  close  together  and  the  line  appears 
solid;  but  usually  the  location  of  the  transition  from  the  thick  to  the  thin  zone  can 
be  easily  detected.  If  this  transition  is  "smooth"  and  the  "constant"  zone  at  the 
end  of  the  thick  region  is  not  too  long,  then  DTAU  has  been  selected 
appropriately,  If  these  features  are  not  present,  then  the  case  should  be  run 
again  with  a different  DTAU  value.  It  should  also  be  noted  that  often  for  low  TW 
values  that  the  degree  of  ionization  near  the  wall  goes  to  zero.  This  trend  would 


be  physically  expected  and  doesn't  seem  to  affect  the  quality  of  this  approximate 
solution. 

At  this  point  the  program  proceeds  to  compute  the  radiative  heating  to  the 
wall.  This  takes  several  seconds.  When  it  is  finished*  there  will  appear  at  the 
top  of  the  screen  a summary  of  the  radiative  heating  results*  along  with  the  shock 
standoff  distance,  XS,  accounting  for  chemistry,  radiative  cooling*  and  heating  to 
the  wall.  This  output  for  the  sample  case  is  included  in  this  appendix. 

After  storing  the  radiative  heating  results  and  the  screen  plot  in  the 
appropriate  files*  the  program  then  asks  if  another  calculation  is  desired.  If  yes 
enter  Y and  continue.  If  no,  enter  N and  the  program  will  return  to  QuickBasic  or 
the  system  as  appropriate. 

To  retrieve  a plot,  use  the  program  PLOTPIC.  In  PLOTPIC*  statement  40  may 
have  to  be  modified  to  reflect  on  which  drive  the  plot  has  been  actually  stored. 
To  use  it*  unload  any  other  program,  load  PLOTPIC*  and  then  do  a run  and  start 
from  QuickBasic.  When  the  prompt  FILE  NAME?  appears  enter  the  fundamental 
name  of  the  file.  For  the  sample  case,  enter  SAMPP.  The  plot  will  appear  along 
with  a prompt  "?".  If  you  wish  to  retrieve  another  plot,  enter  Y.  If  not,  enter  N. 
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I REM  ******  PROGRAM  RAPROX  ***** 

REM 

REM  An  approximate  solution  which  Includes  the  effects  of  chemical 
REM  and  thermal  nonequi librium  and  nonequilibrium  nongray  radiative 
REM  transfer  and  which  Is  suitable  for  rapidly  obtaining  approximate 
REM  stagnation  point  solutions  for  flovfleld  structure  and  estimates 
REM  of  radiative  heat  transfer.  Valid  only  when  flovfleld  Is  dominated 
REM  by  atomic  and  Ionization  processes  and  dissociation  can  be  reasonably 

REM  assumed  to  be  "complete"  in  the  shock  front.  Thus,  frees cream 

REM  velocities  should  be  in  the  11  - 18  ka/sec  range. 

REM 

REM  Developed  by  Dr.  Leland  A.  Carlson,  Aerospace  Engineering  Dept. 

REM  Texas  A&M  University,  College  Station,  TX  77843. 

REM  Program  follows  the  theory  presented  in 
REM  AIAA  Paper  No.  88-2672. 

REM 

9 DEF  FNBB  (VT)  - (EXP(-VT)  •<6+6*VT+3*VTA2+VTA3)+.5*  EXP(- 2 * VT)  * (.75  + 1 
.5  • VT  + 1.5  * VT  A 2 + VT  A 3))  * .1539897# 

10  DIM  QR(8) , TU(8) , K(8) , BO(8),  K0(8),  EI(8),  E0(8),  B(8) 

II  DIM  DA (20) , NA$(20) 

12  DIM  Hl(101) , H2 (101) , BB(101),  DD(101)  , CC(101) , AA(101),  Xl(10l),  X2(101) 

39  INPUT  "U  INFINITY  IN  KM/SEC  IS  • ; U1 
U1  - U1  • 1000001 

INPUT  "P  INFINITY  IN  DYNES/SQ  CM  IS  •;  PI 
INPUT  *T  INFINITY  IN  DEG  K IS  ■;  T1 
INPUT  "NOSE  RADIUS  IN  CM  IS  RN 
HA  - 3.36E+11:  HI  - 1.34E+12 
REM  PI  - PI  / 760  * 1013000! 

HS  - .5  * U1  * U1  - HA 
CP  - 1.48E+07 
TS  - HS  / CP 

HA  - HA  / HS:  HI  - HI  / HS 
R - 8 . 313E+07  / 28! 

R1  - PI  / (R  * Tl) 

PS  - R1  * U1  * U1 
REM  INPUT  *E2" ; E2 
E2  - .1 

FOR  IT  - 1 TO  50 

T2  - TS  * (1  - E2  * (HI  - HA))  / (1  + E2) 

D2  - -TS  * (HI  - HA)  / (1  + E2)  - TS  / (1  + E2) 

FE  - E2  * E2  / (1  - E2  A 2)  - 1.498  * (T2  A 2.5)  /PS  * EXP(-169000  / T2) 

FP  - 2 * E2  / (1  - E2  A 2)  - E2  A 2 / ((1  - E2  A 2)  A 2)  - 1.498  * 2.5  / PS  * (T2  A 1.5)  * D2 

* EXP(-169000  / T2)  - 1.496  * (T2  A .5)  / PS  * 169000  * D2  * EX?(-169000  / T2) 

EN  - E2  - FE  / FP 

IF  EN  < 0 THEN  EN  - E2  / 2 

ER  - ABS (EN  - E2) 

IF  ER  < .00001  GOTO  98 
E2  - EN 

PRINT  "E2-";  E2 ; " T2-" ; T2;  " F-" ; FE;  " FP-" ; FP 
NEXT  IT 

PRINT  "DIDN'T  CONVERGE" 

GOTO  9999 

98  PRINT  "CONVERGED  E2-";  EN;  " T2-" ; T2 
PRINT  "IT-";  IT 

99  PRINT 

21  GOSUB  2000 

25  T3  - T2 

26  GOSUB  3000 

UT  - U1  / 100000! 

IF  UT  > 11  GOTO  27 
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XR  - • *7782 
GOTO  40 

27  IF  UT  > 12  GOTO  28 
XR  - -.5191  * (UT  - 
GOTO  40 

28  IF  UT  > 13  GOTO  29 
XR  - -.4366  * (UT  - 
GOTO  40 

29  IF  UT  > 14  GOTO  30 
XR  - -.3093  • (UT  - 
COTO  40 

30  IF  UT  > 15  GOTO  31 
XR  - -.2603  • (UT  - 
GOTO  40 

31  IF  UT  > 16  COTO  32 
XR  - -.1611  * (UT  - 
GOTO  40 

32  IF  UT  > 17  GOTO  33 
XR  - -.1105  * (UT  - 
GOTO  40 


(UT  - 10)  + 5.5086 


33 

XR 

- -.0361  * 

(UT  - 

40 

XR 

- EXP  (XR)  / 

PI 

N - 3 

CP 

- 1 .48E+07 

MA 

- 2. 32E-23 

K - 1.38E-16 

RR 

- PS  * MA  / 

K / 1 

L - .75  * RN  / 

RR 

TV 

- 1650 

MT 

- 50000:  EM 

- 1 

HA 

- 3.36E+11 

HI 

- 1.34E+12 

11)  + 4.7305 

12)  + 4.2113 

13)  + 3.7747 

14)  + 3.4654 

15)  + 3.2051 

16)  + 3.044 

17)  *►  2.9335 


TS  / R1 


R - (8 . 313E+07)  / 28! 


DT 


PL$ 


41  INPUT  "IM  AND  DTAU" ; IM, 

42  INPUT  "PLOT  NAME";  PN$ 

43  INPUT  "OUTPUT  FILE  NAME  IS"; 

44  GOSUB  1000 
50  PR  - .67 

55  HS  - .5  * U1  * U1  - HA 
60  TS  - HS  / CP 

65  MU  - (4!  / 15!)  * (MA  / K)  * 62.7  * (TS 
70  R1  - PI  / (R  * Tl) 

75  RE  - R1  * U1  * L / MU 
77  PRINT  "REYNOLDS  NO  ; 


.75) 


RE 


80  PS  - R1  * U1  * U1 

85  K1  - (PS  / (K  * TS))  * SI 

90  A - K1  * L 

95  K2  - S2  * (1  - E2)  ★ PS 


6.28  * £1  / (R1 
12.57  * K2  * B2 
(1  - T2  / TS)  / 
(1  + E2)  * T2 
(PS  / (K  * T2) ) 


+ E2)  * T2) 


U1 

(KI 


100  G1 

105  G2 

106  E2 
110  H2 

D9 

PRINT  "ESTIMATED  VALUE  OF  DTAU  IS 
PRINT  "YOUR  INPUT  DTAU  IS  CURRENTLY 
INPUT  "DO  YOU  WISH  TO  CHANGE  DTAU?"; 
IF  AN$  - "N"  GOTO  115 
INPUT  "NEW  DTAU  IS  " ; DT 
115  TA  - .5  * Kl  * (1  + (1  / H2))  * XR 
120  B - 2.31  / TA 


★ HS) 
/ HS  - 


HA  / HS)) 


/ (K  * (1 

* U1  * HS) 

* L / (R1  * 

(T2  / TS  + 

* CP  / HS 

* SI  * XR  / SQR(H2)  / (IK  - 1) 
D9 

; DT 
AN$ 


ORIGINAL  RAGE  IS 
OF  POOR  QUALITY 


I 

If 


mi 


125  HI  - (1.34E+12)  / HS 
130  HA  - (3.36E+11)  / HS 

135  A1  - (2.9E-12)  * HS 

136  E2  - (1  * T2  / TS)  / (T2  / TS  + (HI  - HA)) 

139  BC  - E2  - Al  • H2 

140  SO  - 0 

141  FOR  I - 2 TO  IM 

142  TI  - (I  * 1)  • 1>T 

! U3  SU  - SU  + .5  * DT  * (EX?(*2  * TI)  / (1  - TI  / (K1  * L))  + EXP(-2  * (TI  • DT))  / (1  - (TI  - 0 

j T)  / (K1  * L))) 

144  NEXT  I 

145  HB  - (1  - Cl  * SU  - BC  * (HI  - HA))  / (1J  + Al  * (HI  • HA)) 

150  EQ  - Al  * HB  + BC 

155  HE  - HB  / (1  + EQ) 

160  C - (HI  - HA)  * EQ  + B 

165  D - HE  * EQ  * B * B 
172  01  - DT 
175  FOR  I - 1 TO  IM 
180  TI  - (I  • 1)  * DT 

185  BB(I)  - A / (RE  * PR  * DT  * DT)  + (1  - TI  / A)  / (2  * DT) 

190  DD(I)  - -2  * A / (RE  * PR  * DT  * DT) 

195  AA(I)  - A / (RE  * PR  * DT  * DT)  - (1  • TI  / A)  / (2  * DT) 

200  CC(I)  - Cl  * EXP(-2  * TI)  + ((1  - TI  / A)  * C - A * D / (RE  * PR))  * EXP(-B  * TI) 

210  NEXT  I 

215  Z1  - -RE  * PR  * 2 * DT  / A 
; 220  Z2  - RE  * PR  * 2 * DT  / A - 2 * DT  * HE  * EQ  * B 

225  DD(1)  - DD(1)  + BB(1)  * Z1 
230  AA(1)  - AA(1)  + BB(1) 

235  CC(1)  - CC(1)  - BB(I)  * Z2 
240  BB(IM)  - 0 
I 241  AA(1M)  - 0 

242  DD(IK)  - 1 

243  CC(IK)  - HB 
245  IL  - 1 

250  10  - IM 
255  GOSUB  9000 
260  FOR  I - 1 TO  IM 
265  H1(I)  - CC(I) 

270  NEXT  I 

275  SU  - 0! 

276  Xl(l)  - 0! 

280  FOR  I - 2 TO  IM 

285  SU  - SU  + .5  * (SQR(H1(I  - 1))  + SQR(H1(I)))  * DT  / (K1  * L) 

290  X1(I)  - SU 
295  NEXT  I 

300  HO  - (1  + EQ)  * (Hl(IM)  - EQ  * HE) 

! 301  T3  - HO  / (1  + EQ)  * TS 

j 302  GOSUB  3000 

j 303  K2  - S2  * (1  - EQ)  * PS  / (K  * (1  + EQ)  * T3) 
j 304  G2  - 12.57  * K2  * B2  * L / (R1  * U1  * HS) 

I 305  PRINT  HB;  ” H0-";  HO 


310 

TM 

- K2  * 

L * 

SQR(HO) 

312 

NM 

- 1 - 

(IM  - 

1)  * D1 

/ K1  / L 

314 

TB 

- TM  * 

(1  - 

NM) 

315 

DT 

- (TM 

- TB) 

/ (IM  * 

I) 

325 

TV 

- TW  / 

TS 

326 

TI 

- (IM 

- 1) 

* D1 

327 

E - EQ  * 

(1  - 

EXP( -B  * 

TI)) 

328 

BC 

- E - , 

Al  * 

HO 

330 

HU 

- TU  * 

(1  + 

■ BC)  / (1  - Al  * TV) 

! 
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335  Cl  - X + Al  * (HI 
340  FOR  I - 1 TO  1H 
342  TI  - (I  * 1) 


• HA) 


345  H2(I)  - (HW  - HO)  / 


TB)  • (Tl  - TB)  + HO 


* DT  + TB 

. . . OM 

? 350**' NEXT  I 
352  IT  - 0 

354  IT  - IT  + 1 

355  DD(1)  - 1 
360  AA(1)  - 0 
365  CC(1)  - * (H2(l) 

370  DD(IM)  - 1 

375  BB(IM)  - 0 

380  CC(IM)  - HU  - H2(IM) 

385  FOR  I - 2 TO  IM  - 1 

387  TI  - (I  - 1)  * DT  + TB 
390  BB(I)  - -Cl  * (1  - TI  / TM)  / (2  * DT)  - TM  / (RE  * PR  * DT  * DT) 


HO) 
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395  DD(I)  - 2 * TM  / (RE  * PR  * DT  * DT)  + 


C2  / (K2  * L)  * H / HO  * ((H2(I)  / HO)  (N  - 1)) 

400  AA(I)  - Cl  * (1  - TI  / TM)  / (2  * DT)  * TM  / (RE  • PR  • DT  * DT) 

H2(I  - 1)  + 2 * TM  / (RE  * PR  * DT  * DT)  * H2(I)  + C2  / (K2  * L)  • ((H2(I)  / 
H2(I  + 1) 


405  CC(I)  - BB(I) 
HO)  * N)  + AA(I ) * 


410 

CC(I)  - -CC(I) 

415 

NEXT  I 

420 

IL  - 1 

425 

IU  - IM 

430 

COSUB  9000 

435 

FOR  I - 1 TO  IM 

440 

H2 (I ) - H2 (I ) + CC(I) 

445 

NEXT  I 

450 

DM  - 0 

455 

FOR  I - 1 TO  IM 

460 

T5  - ABS(CC(I) ) 

465 

IF  T5  < DM  GOTO  475 

470 

DM  - T5 

475 

NEXT  I 

480 

IF  DM  < .001  GOTO  520 

485 

FOR  I - 1 TO  IM 

490 

PRINT  CC(I) ; " 

495 

NEXT  I 

500 

PRINT 

505 

IF  IT  > 5 GOTO  9500 

510 

GOTO  354 

520 

PRINT  "THIN  CONVERGED 

IN  " 

525 

SU  - 0 

530 

X2(l)  - XI (IM) 

535 

FOR  I - 2 TO  IM 

540 

SU  - SU  + .5  * (SQR(H2 (I)  / 

545 

X2 (I)  - SU  + X2(l) 

550 

NEXT  I 

560 

XS  - X2(IM) 

562 

OPEN  PL$  FOR  OUTPUT  AS 

#i 

565 

REM  PRINT  D$;  "WRITE** ; 

PL$ 

571 

RR  - PS  * MA  / K / TS  / R1 

572 

PRINT  #1.  "THICK  SOLUTION" 

573 

PRINT  *1,  "RE-";  RE;  " 

Gl-1 

575 

FOR  I - 1 TO  IM 

580 

TI  - (I  - 1)  * D1 

585 

E - EQ  * (1  - EXP( -B  * 

TI)) 

590 

T - HI (I)  - E * HE 

595 

TD  - T * HS  / CP 

596 

RB  - 1 / H1(I) 

IT 


Cl;  " G2- 


G2 ; " U Ul;  " PI—" ; PI;  " RHOS/RINF-" ; R S 


w/s 


i 


J 


I 


597  UB  - -(1  - TI  / A)  * H1(I) 

59«  XL  - (XS  - XI (I))  • L 

600  PRINT  #1,  *X-* ; X1(I);  * H-";  H1(I); 

605  NEXT  I 

607  PRINT  #1,  ’THIN  SOLUTION* 

$610':  FOR  I - 1 TO  IK 
615  TI  - (I  - 1)  * DT  + TB 
620  E - A1  * H2(I)  + BC 
I 625  T - H2(I)  / (1  + E) 

630  TO  - T * HS  / CP 

631  RB  - 1 / H2(I) 

632  UB  - -(1  - TI  / TM)  * H2(I) 

633  XL  - (XS  - X2(I))  * L 

635  PRINT  #1,  *X-*;  X2(I);  " H-*;  H2(I): 
640  NEXT  I 

645  CLOSE  #1 

646  COSUB  1500 

647  PL$  - PL$  + *.HT* 

650  CLS 
SCREEN  1 

651  COLOR  0,  0 

652  LINE  (0,  0) - (279 , 0),  1 
LINE  -(279,  159),  1 
LINE  -(0,  159),  1 

LINE  -(0.  0),  1 

653  T - Hl(l) 

MT  - MT  / TS 

654  IF  T > KT  THEN  MT  - T 

655  Ml  - MT  * TS 

657  TP  - -T  / MT  * 159  +159:  X?  - 0 

658  LINE  (XP,  TP) - (XP , TP),  2 
660  FOR  I - 1 TO  IM 

665  TI  - (I  - 1)  * D1 
; 670  E - EQ  * (1  - EXP(-B  * TI)) 

j 675  T - HI (I)  - E * HE 

J 690  TP  - -T  / KT  * 159  + 159 
695  XP  - X1(I)  / X2 (IM)  * 279 
700  LINE  -(XP,  TP),  2 
710  NEXT  I 

720  E - Al  * H2 (1)  + BC 

725  T - H2(l)  / (1  + E) 

730  TP  - -T  / MT  * 159  + 159 
732  XP  - X2(l)  / X2(IM)  * 279 
735  LINE  (XP,  TP) - (XP,  TP),  2 
740  FOR  I - 2 TO  IM 
745  E - Al  * H2 (I)  + BC 
! 746  IF  E < 0 THEN  E - 0 

750  T - H2(I)  / (1  + E) 

755  TP  - -T  / KT  * 159  + 159 
760  XP  - X2 (I)  / X2(IM)  * 279 
765  LINE  (XP.  TP) - (XP,  TP),  2 

770  NEXT  I 

771  E5  - EM 

772  IF  1.1  * E2  > EM  THEN  EM  - 1 . 1 * E2 
j 775  FOR  I - 1 TO  IM 

j 780  TI  - (I  - 1)  * D1 
I 785  E - EQ  * (1  - EXP( -B  * TI)) 

! 790  EP  - E / (EM)  * (-159)  + 159 
795  XP  - X1(I)  / X2 (IM)’  * 279 
800  LINE  (XP,  EP)  - (XP , EP) , 1 


• T--;  TD;  • E-" ; E;  • R-B;  RB;  • U-B;  UB;  * X-*;  XL 


TO;  ■ E-";  E;  ■ R-* ; RB;  ■ U-";  UB;  • X-";  XL 
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810  E - Al  * H2(l)  + BC 

815  IF  E < 0 THEN  E - 0 

820  EP  - E / (EM)  * (-159)  ♦ 159 

825  XP  - X2(I)  / X2(IM)  * 279 


840  T5  - 10000 

845  TP  - -T5  / TS  / KT  * 159  + 159 

850  IF  TP  < 0 GOTO  870 

855  LINE  (0.  TP) -(5.  TP).  3 

860  T5  - T5  + 10000 

865  GOTO  845 

870  E3  - .1 

875  EP  - E3  / (EK)  * (-159)  -*■  159 

880  IF  EP  < 0 GOTO  900 

885  LINE  (275.  EP)-(279,  EP) . 3 

890  E3  - E3  + .1 

895  GOTO  875 

900  KT  - Ml 

902  EM  - E5 

DEF  SEG  - &HB800 
905  BSAVE  PN$ . 0.  &H4000 

907  OPEN  PL$  FOR  OUTPUT  AS  #1 

908  REM  PRINT  D$;  "WRITE*;  PL$ 

912  FOR  I - 1 TO  15  STEP  2 

915  PRINT  #1,  NAS(I);  "-* ; DA(I);  ’ NA$(I  + 1);  DA(I  + 1) 

'920  NEXT  I 

921  PRINT  #1.  "E2-";  E2;  " EQ-";  EQ 

925  PRINT  #1,  "IM-" ; IK;  " DTAU-" ; Dl;  " XS-";  XS  * L 
PRINT  #1,  "R£  RN 
935  QR  - 0 

940  FOR  I - 2 TO  IM 

945  QR  - QR  + .5  * <(H2(I)  / HO)  * N + (H2(I  - 1)  / HO)  A N)  * DT 
950  NEXT  I 

955  QR  - QR  * 12.57  * B2  / 2 / 1E+07 

960  REM  PRINT  #1.  "QR-* ; QR;  " WATTS/SQ  CK" 

961  QT  - 12.57  * K2  * B2  * SQR(HO)  / K1  * ((HE  / HO)  A N)  * (IM  - 1)  * Dl  / 2E+07 

962  REM  PRINT  #1,  "QRT-";  QT;  ■ WATTS/SQ  CK* 

963  QT  - QT  + QR 

964  REM  PRINT  #1.  "QR( TOTAL  VIS)-";  QT 
970  GOSUB  7000 

977  PRINT  #1,  "QC-” ; QC;  " WATTS/SQ  CK" 

978  GOSUB  8300 

979  CLOSE  #1 

981  PRINT  "VUV  - ’;  QR(1)  + QR(2)  + QR(3)  + QR(4) ; * XS-" ; XS  * L 

982  PRINT  "LINE  REGION  - *;  QR(6)  + QR(7);  "RB  -" ; RN 

983  PRINT  "VIS  AND  IR  - QR(5)  + QR(8);  " QRTOT-" ; QR(1)  + QR(2)  + QR(3)  + QR(4)  + QR(5)  + QR 

(6)  + QR(7)  + QR(8) 

985  GOTO  9990 
1000  DA(1)  - U1 

1002  DA(2)  - PI 

1003  DA(3)  - T2 

1004  DA(4)  - E2 

1005  DA (5)  - SI 

1006  DA(6)  - S2 

1007  DA(7)  - B1 

1008  DA(8)  - B2 

1009  DA(9)  - XR 

1010  DA(10)  - L 

1011  DA ( 1 1 ) - N 


J 


1012 

1013 

1014 

1015 
*1021 
*1022 

1023 

1024 

1025 

1026 

1027 

1028 

1029 

1030 

1031 

1032 

1033 

1034 

1035 
j 1060 
! 1065 

1067 
1069 
1075 
1080 
1085 
1090 
1095 
1100 

1115 

1116 

1117 

1118 

1119 

1120 
1125 

1132 

1133 

1134 

1135 

1136 

1137 

1138 

1139 

1140 

1141 

1142 

1143 

1144 

1145 

1146 
1500 
1505 
1510 
1515 
1520 
1522 
1525 
1530 
1535 


DA(12)  - T1 
DA(13)  - TW 
DA (14)  - MT 
DA(15)  - EH 

HA$U>  - . 

NA$(2)  - - 

HA$(3)  - * 

NA$<4)  - 
HA$(5)  - 
HA$ (6)  - 
HA$(7)  - 
HA$(8)  - 
HA$(9)  - 
HA$(10)  - 
NA$(11)  - 
NA$ ( 12 ) - 
NA$ (13)  - 


'iac.v. *->. r-  r rV'  "'^4^*' 


na$(i);  *-*;  da(I) 


T2’ 

E2* 

SI* 

S2* 

Bl* 

B2" 

XR* 

*L* 

*N* 

*TX* 

"TV* 

NA$ ( 14  ) - "PLOT  TMAX" 

NA$(15)  - "PLOT  EPS  MAX* 

CLS 

FOR  I - 1 TO  15 
PRINT  "VAR  ■;  I; 

NEXT  1 

INPUT  ’ARE  THESE  OKAY?  Y OR  N" ; AN$ 

IF  AN$  - "Y”  GOTO  1125 
IF  AN$  - "N”  GOTO  1095 
GOTO  1075 

INPUT  "WHICH  ONE  SHOULD  BE  CHANGED?  I 
PRINT  "INPUT  NEW  VALUE  FOR  ";  NA$(I) 
INPUT  DA (I) 

T2  - DA(3) 

T3  - T2 
GOSUB  2000 
GOSUB  3000 
GOTO  1060 
U1  - DA(1) 

PI  - DA(2) 

T2  - DA(3) 

E2  - DA(4) 

51  - DA(5) 

52  - DA(6) 

Bl  - DA(7) 

£2  - DA(8) 

XR  - DA(9) 

L - DA(10) 

N - DA(ll) 

T1  - DA(12) 
rw  - DA (13) 

KT  - DA ( 1 A ) 

EM  - DA ( 1 5 ) 

RETURN 

Pl$  - PL$  + ".PI" 

OPEN  Pl$  FOR  OUTPUT  AS  #1 
REM  PRINT  D$;  "WRITE";  Pl$ 

PRINT  *1 , IK 
PRINT  #1,  IM 
FOR  J - 1 TO  2 
FOR  I - 1 TO  IM 
TI  - (I  - 1)  * D1 
E - EQ  * (1  - EXP(-B  * TI)) 
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1540  T - HI (I)  - E * HE 
1545  TO  - T * HS  / CP  / 10000 
1550  XL  - (XS  • Xl(I))  * L 
1555  PRINT  *1,  XL 
1560  IT  J - 1 THEN  PRINT  #1.  TD 
#15624 IP. E.<  0 THEN  E - 0 

1565"  IF' J-  2 THEN  PRINT  #1,  E * 5 

1570  NEXT  I 

1575  NEXT  J 

1580  CLOSE  #1 

1600  P2$  - PL$  + * .P2* 

1605  OPEN  P2$  FOR  OUTPUT  AS  #1 
1610  REM  PRINT  D$;  "WRITE";  P2$ 

1615  PRINT  #1,  IK:  PRINT  #1,  IK 

1625  FOR  J - 1 TO  2 

1630  FOR  I - 1 TO  IM 

1635  TI  - (I  - 1)  • DT  + TB 

1640  E - Al  • H2 (I)  + BC 

1645  T - H2(I)  / (1  + E) 

1650  TD  - T • HS  / CP  / 10000 

1655  XL  - (XS  - X2 ( I ) ) * L 

1660  PRINT  #1,  XL 

1665  IF  J - 1 THEN  PRINT  #1.  TD 

1667  IF  E < 0 THEN  E - 0 

1670  IF  J - 2 THEN  PRINT  #1,  E * 5 

1675  NEXT  I 

1680  NEXT  J 

1685  CLOSE 

1690  RETURN 

2000  CF  - 2.302585 

2003  Y - T2  / 10000! 

2005  IF  T2  > 8000  GOTO  2025 

2010  REM  S1-8.17E-16 

2011  SI  - 0 
2015  B1  - 0 
2020  GOTO  2170 

2025  IF  T2  > 10000  GOTO  2055 

2035  SI  - (1 . 0061E-13)  * (10!  * (-2.6064  * y>) 

2040  £1  - 10!  A (-65.26966  + 15.87146  * L0G(T2)  / CF) 

2050  GOTO  2170 

2055  IF  T2  > 12000  GOTO  2085 

2065  SI  - (9 . 6882E- 15)  * (10!  * (-1.5953  * Y) ) 

2070  £1  - 10!  * (-54.67501  + 13.22279  * LOG(T2)  / CF) 

2080  GOTO  2170 

2085  IF  T2  > 14000  GOTO  2110 

2090  SI  - (2 . 034E-15)  * (10!  A (-1.0304  * y)) 

2095  £1  - 10!  A (-47.32488  + 11.42093  * LOGCT2)  / CF) 

2105  GOTO  2170 

2110  IF  T2  > 16000  GOTO  2135 

2115  SI  - (6 . 9685E-16)  * (10!  A (-.6981  * Y) ) 

2120  £1  - 10!  A (-41.90448  + 10.11359  * LOG(T2)  / CF) 

2130  GOTO  2170 

2135  IF  T2  > 18000  GOTO  2160 

2140  SI  - (3 . 3188E- 16)  * (10!  A (-.49675  * Y) ) 

2145  £1  - 10!  A (-37.77432  + 9.131181  * LOG(T2)  / CF) 
2155  GOTO  2170 

2160  SI  - (2 . 0976E-16)  * (10!  * (-.38605  * Y)) 

2165  B1  - 10!  A (-34.49941  + 8.36166  * LOG(T2)  / CF) 
2170  Bl  - £1  * 1E+09 
2172  DA(5)  - SI 
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2175  DA(7)  - B1 
2180  RETURN 
3000  CF  - 2.302585 
3005  Y - T3  / 10000! 


• Y)) 

LOG(T3)  / CF) 


LOG(T3)  / CF) 


3020  B2  - 0 

3025  GOTO  3140 

3030  IF  T3  > 10000  GOTO  3050 

3035  S2  - (3.4065E-30)  • (101  * (7.2773  * Y)) 

3040  B2  - 10!  * (-16.52511  + 4.425444  * L0C(T3)  / CF) 
3045  GOTO  3140 
3050  IF  T3  > 12000  GOTO  3070 
3055  S2  - (8.3188E-28)  • (101  * (4.8895 
3060  B2  - 10!  * (-15.30031  + 4.119244  * 

3065  GOTO  3140 
3070  IF  T3  > 14000  COTO  3090 
3075  S2  - (2.8643E-26)  * (10!  * (3.6087  * Y)) 

3080  B2  - 10!  * (-14.17392  + 3.843113  • 

3085  COTO  3140 
3090  IF  T3  > 16000  COTO  3110 
3095  S2  - (1.9928E-25)  * (10!  A (3.00695  * Y)) 

3100  B2  - 10!  * (-13.12  + 3.588921  * L0C(T3)  / CF) 

3105  COTO  3140 
3110  IF  T3  > 18000  GOTO  3130 
3115  S2  - (3.9376E-24)  * (10!  * (2.1971  * Y)) 

3120  B2  - 10!  A (-12.13764  + 3.355253  * L0G(T3)  / CF) 
3125  COTO  3140 

3130  S2  - (4 . 2515E-24)  * (10!  A (2.1786  * Y)) 

3135  B2  - 10!  A (-11.2815  + 3.154  * L0G(T3)  / CF) 

3140  B2  - B2  * 1E+10 
3145  DA(6)  - S2 

3150  DA(8)  - B2 

3155  RETURN 
7000  T4  - TW  * TS 

7005  VI  - (4!  / 15!)  * (MA  / K)  * 62.7  * (T4  A .75) 

7010  T3  - HO  / (1  + EQ)  * TS 
7015  COSUB  3000 

7020  K2  - S2  • (1  - EQ)  * PS  / (K  * (1  + EQ) 

7025  QC  - VI  * KS  / PR  * K2  / SQR(H.2(IK)  / HO)  * 

- 1)  + 11  * H2 (IM) ) / (6  * DT) 

7030  QC  - -QC  / 1E+07 
7035  PRINT  “QC-" ; QC;  " UATTS/SQ  CM" 

7040  RETURN 

8300  PI  - 3.14159:  SB  - 5.6697E-05 
8305  FOR  J - 1 TO  8:  QR(J)  - 0:  EO(J)  ■ 

8310  T - TV  * TS:  E - 0:  NA  - PS  / (K  * 

8315  GOSUB  8800 

8320  FOR  J - 1 TO  8:  KO(J)  - K(J) 

8325  FOR  I - 1M  - 1 TO  1 STEP  -1 

8330  E - Al  * H2 (I)  + BC:  T - H2(I)  / (1  + E)  * HS  / CP 

8335  IF  E < 0 THEN  E - 0 

8340  NA  - (1  - E)  * PS  / ((1  + E)  * K * T) 

8345  GOSUB  8800 
8350  FOR  J - 1 TO  8 


* T3) 

(-2  * H2(IM 


- 3)  + 9 * H2 (IK  - 2)  - 18  * H2(1M 


0:  TU(J)  - 0:  NEXT  J 
T) 


BO(J)  - B(J) : NEXT  J 


8355  TU(J) 
8360  El (J) 
8365  QR(J) 
L 

8370  BO(J) 


- TU(J)  + .5  * (K(J)  + KO(J) ) * (X2 (I  + 1)  - X2 (I) ) * L 

- DIP(-2  * TU(J) ) 

- QR(J)  + .5  * (BO(J)  * KO(J)  * EO(J)  + E1(J)  * K(J)  * B(J))  * (X2(I  + 1)  - X2(I))  * 

- B(J):  KO(J)  - K(J) : EO(J ) - EI(J) 
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NEXT  J 
NEXT  I 

i FOR  I - IN  - 1 TO  1 STEP  -1 

JLz  Ci  *.  i), 

R^  BQ  * (1- 
T - HE  * HS  / CP:  TH  - (H1(I)  - E * HE) 
NA  - (1  - E)  * PS  / <K  * <TH  + E * T)) 
CR  - E • E / (1  - E)  * (1  • EQ)  / (EQ 
COSUB  8800 
FOR  J - 1 TO  4 
FOR  J - 5 TO  8 
FOR  J - 1 TO  8 
TU(J)  - TU(J)  + .5  * (K(J) 

EI(J)  - EXP( -2  * TU(J) ) 

QR(J ) - QR(J)  + .5  * (BO(J) 
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EX?(-B  • TI))«*-# 


B(J)  - CR  * B(J) : NEXT 
K(J)  - CR  * K(J) : NEXT 


...  *r% . 

rW»..«w*4  v .«>  -> 

* HS  / CP 

2) 

J 

J 


* • , ' vs>ssi*v- ~ .-i  * - 


••iNKf-'-r- 


+ KO(J) ) * (X1(I 
K0(J)  * E0(J) 


+ 1)  - X1(I))  * L 

+ El (J)  * K(J)  * B(J) ) * (X1(I  + 1) 


xi(D)  * 


B0(J)  - B(J) : KO(J)  - K(J) : EO(J) 
NEXT  J 
NEXT  I 
FOR  J - 1 
PRINT  #1, 

PRINT  #1. 

PRINT  #1, 

PRINT  #1, 

+ QR<7)  + 

RETURN 
BT  - SB  * 


EI(J) 


NEXT  J 


TO  8:  QR(J)  - QR(J)  * 6.2832  / 1E+07:  PRINT  #1,  QR(J);  " 1 

"VUV  ■;  (QR(1)  + QR(2)  + QR(3)  + QR(4)) 

"VUV  LINES  •;  (QR(6)  + QR(7)) 

"VIS+IR  ■;  (QR(5)  + QR(8));  " QRT0T-";  QR(1)  + QR(2)  + QR(3)  + QR(4)  + QR(5)  + Q 

QR  (8) 


(T  A 4)  / PI 
T / 168800:  VT  - 

- BT  * (FNBB(VT) ) 
.925  / TT:  B(2)  - 
.835  / TT 

- BT  * (FNBB(VT)) 


1 / TT 

BT  * (FNBBCVT))  - B(l) 


- B(2)  - B(l) 


VT  - .754  / TT 

B(4)  - BT  * (FNBB(VT))  - B(3)  - B(2)  - B(l) 

VT  - .473  / TT 

B(6)  - BT  * (FNBB(VT) ) - B(4)  - B (3)  - B(2)  - B(l) 
VT  - .213  / TT:  B(8)  - BT  - BT  * (FNBB(VT)) 

B(5)  - BT  - B(S)  - B(6)  - B(4)  - B(3)  - B(2)  - B(l) 

- E) 

B(6)  * EXP(. 162  / TT) 
EXP<-.246  / TT) 

£XP( - . 165  / TT)  + K(4) 


* NA  / (1 
2.4E-21  * 
1.7E-17  * 
2. IE- 17  * 
K(3) 
1.1E-17 
2.6E-17 
6E-18  * 
3.2E-17 


N£ 

NA 

NA 


* NA  + K(2) 


NA 

★ 


NA 
* NA 


NE  - E 
B(7)  - 
K(4)  - 
K(3)  - 
K(2)  - 
K(l)  - 
K(5)  - 
K(6)  - 
K(8)  - 
IF  NE 
IF  NE 
K(7)  - 
RETURN 

REM  TRI -DIAGONAL  SOLVER 
LP  - XL  + 1 
FOR  I - L?  TO  IU 
RG  - BB(I)  / DD(I  - 1) 

DD( I)  - DD(I)  - RG  * AA (I 
CC(I)  - CC(I)  - RG  * CC(I 
NEXT  I 

CC(IU)  - CC(IU)  / DD(IU) 
FOR  I - LP  TO  IU 


* EX?( - .723  / TT) 

EXP( - . 379  / TT)  + 

★ EXP(- .631  / TT) 

- 0 THEN  K(7)  - 0 

- 0 GOTO  8915 

1200  * NA  / NE  * EXPC-.489  / TT)  + 


1) 

1) 


K(5) 

+ K(5) 


K(6) 


9080  J - IU  - I + IL 
9090  CC(J)  - (CC(J)  - AA(J)  * 
9100  NEXT  I 
9110  * RETUKH.^^na*^ 
29500»  PRINT  "ABNORMAL  STOP* 


CC(J  ♦ 1))  / DD(J) 


• ' Wf  Sfc  & :* 

* ~ . . >i -V-"  ' 


19505  GOTO  9999 

9990  INPUT  -ANOTHER  CALCULATION?  Y OR  N*;  AN$ 
9991  IF  AN$  - -N*  GOTO  9998 
! 9992  IF  AN$  - "Y"  GOTO  9994 
9993  GOTO  9990 
9994  SCREEN  0 
9995  COSUB  1125 
9996  GOTO  39 

9998  BSAVE  PN$,  0.  &H4000 
9999  END 


i 


ORIGINAL  PAGE  IS 
OF  POOR  QUALITY 


ORIGINAL  PAGE  IS 
OF  POOR~Otm£tTY 


REM  *******  PROGRAM  PLOTPIC.BAS 
5 DEF  SEG  - &HB800 
10  SCREEN  0 

24  CLS 

25  INPUT  "FILE  NAME";  EXT$ 

30  SCREEN  1 

36  COLOR  0,  0 

40  A$  - "C:\QBASIC4\"  + EXT$ 

41  PRINT  A$ 

50  BLOAD  A$,  0 

51  FOR  I - 1 TO  20 

52  PRINT 

53  NEXT 

55  INPUT  AN$ 

60  IF  AN$  - "Y"  GOTO  24 


***-*♦ ._-*.*****  OJ‘i  WASDOS^  HS 

FLOWFIELD  SOLUTION 
Output  from  -file  SAMP 

RE  = Reynolds  No.,  G1  and  G2  are  radiation  cooling  values.  The  X on  the  left  hand 
side  is  nondimensional  coordinate  measured  from  the  shock.  The  X on  the  right 
hand  side  is  dimensional  value  in  cm  from  the  wall.  T is  translational 
temperature  in  deg  K.»  E is  degree  of  ionization,  R is  the  density  ratio  rho/RHOS, 
and  U is  nondimensional  velocity  u/US.  Note  that  the  T immediately  behind  the 
shock  assumes  that  dissociation  is  complete  in  the  shock  -front  and  that 
immediately  behind  the  shock  the  gas  is  composed  entirely  of  atoms  only. 


ORIGINAL  PAGE  IS 
OF  POOR  QUALfTY 


THICK  SOLUTION 

RE-  151.9093  Gl-  4 . 757869E-02 
X-  0 H-  .7940006  T-  50644.36 


original  page  ;q 

0F  poor  QuflLrry 


G2-  4 . 230994E-02  U-  1600000  PI-  24.897  RHOS/RINF-  6.747433 
E-  0 R-  1.259445  0--. 7940006  X-  14.47891 


X-  4 . 547589E-03 

H- 

.7147815 

T-  44267.88 

E-  .1022396 

R-  1.399029 

U— . 711036 

X-  14.36265 

X-  6 . 735756E-03 

H- 

.680485 

T-  41504.18 

E-  .1467433 

R-  1.46954  U--. 6751364  ; 

K-  14.30671 

X-  8 . 871973E-03 

H- 

.6492992 

T-  38989.37 

E-  .1873475 

R-  1.540122 

U-- .6424946 

X-  14.2521 

X-  1 . 095983E-02 

H- 

.6209384 

T-  36700.82 

E-  .2243939 

R-  1.610466 

U—  .6128042 

X-  14.19872 

X-  .0130027  H- 

.5951437  T- 

34617.95  E- 

.2581943  R- 

1.680266  U- 

-.5857881  X- 

14.14649 

X-  1 . 500379E-02 

H- 

.5716802 

T-  32722.13 

E-  .289033 

R-  1.74923  U— . 5611956  : 

X-  14.09533 

X-  1 . 696608E-02 

H- 

.5503349 

T-  30996.39 

E-  .3171696 

R-  1.817075 

U—  .5387999 

X-  14.04517 

X-  1 . 889241E-02 

H- 

.5309148 

T«  29425.36 

E-  .3428409 

R-  1.883541 

U-- .5183958 

X-  13.99592 

X-  2 . 078542E-02 

H- 

.5132444 

T-  27995.06 

E-  .3662628 

R-  1.94839 

U— . 4997975 

X-  13.94753 

X-  2 . 264759E-02 

H- 

.4971647 

T-  26692.78 

E-  .3876325 

R-  2.011406 

U-- .4828364 

X-  13.89992 

X-  2.448124E-02 

H- 

.4825311 

T-  25506.99 

E-  .4071297 

R-  2.072405 

U—  .4673604 

X-  13.85304 

X-  2 . 628856E-02 

H- 

.4692126 

T-  24427.19 

E-  .4249186 

R-  2.13123 

U— . 4532313 

X-  13.80684 

X-  2 . 807156E-02 

H- 

.45709  ' 

r-  23443.85  1 

E>  .4411488  I 

2.187753  U--. 440324  X' 

- 13.76125 

X-  2 . 983214E-02 

H- 

.4460552 

T-  22548.31 

E-  .4559568 

R-  2.241875 

U—  .4285253 

X-  13.71624 

X-  3 . 157205E-02 

H- 

.4360099 

T-  21732.67 

E-  .4694674 

R-  2.293526 

U-- .4177324 

X-  13.67176 

X-  3 . 329294E-02 

H- 

.4268647 

T-  20989.77 

E-  .4817941 

R-  2.342663 

U—  .4078522 

X-  13.62777 

X-  3 . 499632E-02 

H- 

.4185385 

T-  20313.1 

E-  .4930408 

R-  2.389266 

U—  .3988003 

X-  13.58422 

X-  .0366836  H- 

.4109575  T- 

19696.71  E~ 

.503302  R-  : 

2 .433342  U— 

.3905001  X- 

13.54108 

X-  3 . 835608E-02 

H- 

.4040546 

T-  19135.22 

E-  .5126642 

R-  2.474913 

U—  .3828822 

X-  13.49833 

X-  4 , 001499E-02 

H- 

.3977689 

T-  18623.71 

E-  .521206 

R-  2.514023 

U—  .3758837 

X-  13.45592 

X-  4 . 166142E-02 

H- 

.3920448 

T-  18157.72 

E-  .5289993 

R-  2.550729 

U—  .3694475 

X-  13.41382 

X-  4 . 329642E-02 

H- 

.3868321 

T-  17733.18 

E-  .5361098 

R-  2.585101 

U—  .3635217 

X-  13.37203 

X-  4 . 492093E-02 

H- 

.3820848 

T-  17346.39 

E-  .5425973 

R-  2.61722 

U-- .3580593 

X-  13.33049 

X-  4 . 653582E-02 

H- 

.377761 

T-  16993.98 

E-  .5485163 

R-  2.647176 

U— .3530178 

X-  13.28921 

X-  4 . 814192E-02 

H- 

.3738231 

T-  16672.88 

E-  .5539168 

R-  2.675062 

U-- .3483583 

X-  13.24815 

X-  4 . 973996E-02 

H- 

.3702363 

T-  16380.32 

E-  ,558844 

R-  2.700978 

U—  .3440458 

X-  13.20729 

X-  5 . 133062E-02 

H- 

.3669692 

T-  16113.73 

E-  .5633394 

R-  2.725024 

U— .3400485 

X-  13.16663 

X-  5.291453E-02 

H- 

.3639933 

T-  15870.82 

E-  .567441 

R-  2.747303 

U— . 3363372 

X-  13.12613 

X-  5 . 449227E-02 

H- 

.3612826 

T-  15649.48 

E-  .5711832 

R-  2.767916 

U—  .3328859 

X-  13.0858 

X-  5.6 06437E-02 

H- 

.3588133 

T-  15447.77 

E-  .5745975 

R-  2.786965 

U--. 3296706 

X-  13.04561 

X-  5 . 763131E-02 

H- 

.3565638 

T-  15263.96 

E-  .5777127 

R-  2.804547 

U—  .3266696 

X-  13.00555 

X-  5 . 919353E-02 

H- 

.3545146 

T-  15096.46 

E-  .5805548 

R-  2.820758 

U— .3238634 

X-  12.96561 

X-  6 . 075145E-02 

H- 

.3526478 

T-  14943.82 

E-  .583148 

R-  2.835691 

U— .321234  X-  12.92578 

X-  6 . 230543E-02 

H- 

.350947 

T-  14804.71 

E-  .5855139 

R-  2.849433 

U—  .3187653 

X-  12.88605 

X-  6 . 385582E-02 

H- 

.3493976 

T-  14677.94 

E-  .5876725 

R-  2.862069 

U—  .3164425 

X-  12.84642 

X-  6 . 540293E-02 

H- 

.347986 

T-  14562.4  E-  .589642  R-  2.873679  U— .3142524  X-  12.80687 

X-  6 . 694704E-02 

H- 

.3467  T-  14457.11  E-  .5914389  R-  2.884338  U—  .3121826  X. 

- 12.76739 

X-  6.848841E-02 

H- 

.3455282 

T-  14361.15 

E-  .5930784 

R-  2.89412 

U—  .3102223 

X-  12.72799 

X-  7 . 002729E-02 

H- 

.3444607 

T-  14273.69 

E-  .5945742 

R-  2.903089 

U— .3083614 

X-  12.68864 

X-  .0715639  H- 

.3434881  T- 

14193.99  E- 

.595939  R-  ; 

>.911309  U— 

.3065908  X- 

12.64936 

X-  7.309843E-02 

H- 

.342602 

T-  14121.35 

E-  .5971842 

R-  2.918839 

U— .3049022 

X-  12.61013 

X-  7.463107E-02 

H- 

.3417946 

T-  14055.14 

E-  .5983202 

R-  2.925734 

U— .3032882 

X-  12.57095 

X-  7 . 616197E-02 

H- 

.3410589 

T-  13994.8 

E-  .5993568 

R-  2.932045 

U— .3017418 

X-  12.53181 

X-  .0776913  H- 

.3403887  T- 

13939.81  E- 

.6003025  R- 

2.937818  U~ 

-.300257  X- 

12.49271 

X-  7 . 921919E-02 

H- 

.339778 

T-  13889.68 

E-  .6011653 

R-  2.943098 

U— .2988281 

X-  12.45365 

X-  8 . 074577E-02 

H- 

.3392215 

T-  13844  E-  .6019526  R-  2.947927  U— . 2974499  X- 

- 12.41462 

X-  8 . 227115E-02 

H- 

.3387144 

T-  13802.36 

E-  .6026708 

R-  2.95234 

U—  .2961178 

X-  12.37563 

X-  8 . 379544E-02 

H- 

.3382524 

T-  13764.4 

E-  .6033261 

R-  2.956372 

U—  .2948277 

X-  12.33666 

X-  8 . 531874E-02 

H- 

.3378314 

T-  13729.81 

E-  .603924 

R-  2.960056 

U—  .2935757 

X-  12.29771 

X-  8 . 684114E-02 

H- 

.3374478 

T-  13698.28 

E-  .6044695 

R-  2.963421 

U— .2923582 

X-  12.25879 

X-  .0883627  H- 

.3370983  T- 

13669.54  E- 

.6049673  R* 

2.966494  U- 

-.2911721  X- 

12.21989 

X-  8 . 988351E-02 

H- 

.3367797 

T-  13643.35 

E-  .6054214 

R-  2.9693  U—  .2900147  \ 

K-  12.18101 

X-  9 . 140364E-02 

H- 

.3364895 

T-  13619.47 

E-  .6058357 

R-  2.971861 

U—  .2888831 

X-  12.14215 

X-  9 . 292314E-02 

H- 

.3362249 

T-  13597.7 

E-  .6062137 

R-  2.974199 

U—  .2877751 

X-  12.1033 

X-  9 .444207E-02 

H- 

.3359839 

T-  13577.86 

E-  .6065586 

R-  2.976333 

U—  .2866885 

X-  12.06447 

X-  9 . 596048E-02 

H- 

.3357642 

T-  13559.77 

E-  .6068733 

R-  2.978281 

U—  .2856214 

X-  12.02565 

j X-  .0974784  H-  .335564  T-  13543.29  E-  .6071603  R-  2.980058  U— .2845719  X-  11.98685 

X-  .0989959  H-  .3353814  T-  13528.25  E-  .6074223  R-  2.98168  U— .2835384  X-  11.94805 

X-  .100513  H-  .335215  T-  13514.54  E-  .6076613  R-  2.98316  U— .2825194  X-  11.90927 
X-  .1020297  H-  .3350633  T-  13502.04  E-  .6078793  R-  2.984511  U— .2815137  X-  11.87049 

X-  .1035462  H-  .3349249  T-  13490.64  E-  .6080783  R-  2.985744  U— .2805199  X-  11.83172 

X-  .1050623  H-  .3347987  T-  13480.24  E-  .6082598  R-  2.98687  U— .279537  X-  11.79296 
X-  .1065781  H-  .3346834  T-  13470.74  E-  .6084254  R-  2.987899  U— .2785639  X-  11.75421 

X-  .1080937  H-  .3345781  T-  13462.07  E-  .6085765  R-  2.988839  U— .2775997  X-  11.71546 

X-  .1096091  H-  .3344818  T-  13454.15  E-  .6087143  R-  2.989699  U— .2766434  X-  11.67672 

X-  .1111242  H-  .3343937  T-  13446.9  E-  .6088402  R-  2.990487  U--. 2756945  X-  11.63799 

X-  .1126392  H-  .3343129  T-  13440.26  E-  .6089549  R-  2.991209  l)--. 274752  X-  11.59926 

X-  .114154  H-  .3342387  T-  13434.17  E-  .6090596  R-  2.991874  U— .2738152  X-  11.56053 
X-  .1156686  H-  .3341703  T-  13428.57  E-  .6091551  R-  2.992486  U— .2728837  X-  11.52181 

X-  .1171831  H-  .334107  T-  13423.4  E-  .6092423  R-  2.993053  U— .2719566  X-  11.48309 


X- 

.1186974 

H- 

.3340481 

T-  13418.62 

E- 

.6093218 

R-  2.993581 

U— 

.2710335 

X-  11.44438 

X- 

.1202117 

H- 

.3339929 

T-  13414.16 

E- 

.6093944 

R-  2.994076 

u— 

.2701136 

X-  11.40567 

X- 

.1217257 

H- 

.3339408 

T-  13409.98 

E- 

.6094606 

R-  2.994543 

u— 

.2691966 

X-  11.36696 

X-  .1232397  H-  .3338911  T-  13406.02  E-  .609521  R-  2.994989  U— .2682817  X-  11.32825 

X-  .1247536  H-  .3338429  T-  13402.24  E-  .6095761  R-  2.995421  U—  .2673683  X-  U.289S5 

X-  .1262673  H-  .3337955  T-  13398.56  E-  .6096264  R-  2.995846  U— .2664559  X-  11.25085 

X-  .127781  H-  .3337481  T-  13394.94  E-  .6096722  R-  2.996272  U— .2655436  X-  11.21215 

X-  .1292945  H-  .3336995  T-  13391.3  E-  .6097141  R-  2.996708  U— .2646306  X-  11.17346 

X-  .1308079  H-  .3336486  T-  13387.56  E-  .6097522  R-  2.997165  U— .2637161  X-  11.13477 

X-  .1323212  H-  .3335941  T-  13383.64  E-  .6097871  R-  2.997655  U— .262799  X-  11.09608 

X-  .1338344  H-  .3335345  T-  13379.42  E-  .6098189  R-  2.99819  U— .2618782  X-  11.0574 

X-  .1353475  H-  .3334679  T-  13374.8  E-  .6098478  R-  2.99879  U— .2609522  X-  11.01871 
X-  .1368603  H-  .333392  T-  13369.61  E-  .6098744  R-  2.999472  U— .2600193  X-  10.98004 

X-  .138373  H-  .3333042  T-  13363.7  E-  .6098985  R-  3.000262  U— .2590776  X-  10.94137 
X-  .1398855  H-  .3332013  T-  13356.85  E-  .6099205  R-  3.001189  U— .2581247  X-  10.9027 

X-  .1413977  H-  .3330795  T-  13348.82  E-  .6099406  R-  3.002287  U— .2571576  X-  10.86404 

X-  .1429096  H-  .3329339  T-  13339.3  E-  .6099589  R-  3.003599  U— .2561729  X-  10.82539 

X-  .1444212  H-  .332759  T-  13327.93  E-  .6099756  R-  3.005178  U— .2551665  X-  10.78674 

X-  .1459323  H-  .3325478  T-  13314.26  E-  .609991  R-  3.007087  U— .2541333  X-  10.74811 

X-  .1474428  H-  .3322918  T-  13297.75  E-  .6100048  R-  3.009403  U— .2530671  X-  10.70949 

X-  .1489528  H-  .3319809  T-  13277.75  E-  .6100175  R-  3.012222  U— .2519605  X-  10.67089 

X-  .1504619  H-  .3316026  T-  13253.48  E-  .6100292  R-  3.015658  U— .2508046  X-  10.63231 

X-  .1519701  H-  .3311419  T-  13223.96  E-  .6100397  R-  3.019853  13— .2495886  X-  10.59375 

X-  .1534771  H-  .3305805  T-  13188.02  E-  .6100494  R-  3.024982  13— .2482993  X-  10.55522 

X-  .1549828  H-  .329896  T-  13144.25  E-  .6100582  R-  3.031258  13— .2469209  X-  10.51673 

X-  .1564866  H-  .3290616  T-  13090.92  E-  .6100662  R-  3.038944  13— .2454342  X-  10.47829 

X-  .1579884  H-  .3280446  T-  13025.96  E-  .6100736  R-  3.048366  13— .2438162  X-  10.43989 

X-  .1594876  H-  .3268054  T-  12946.83  E-  .6100802  R-  3.059925  13— .2420389  X-  10.40157 

THIN  SOLUTION 

X-  .1594876  H-  .3268054  T-  12946.49  E-  .6100802  R-  3.059925  U— .2420389  X-  10.40157 

X-  .1637641  H-  .3267423  T-  12945.38  E-  .6099077  R-  3.060516  U— .2395478  X-  10.29224 

X-  .1680401  H-  .3266787  T-  12944.26  E-  .6097335  R-  3.061112  U— .2370573  X-  10.18292 

X-  .1723157  H-  .3266144  T-  12943.12  E-  .6095576  R-  3.061714  U— .2345673  X-  10.07361 

X-  .1765909  H-  .3265495  T-  12941.98  E-  .6093799  R-  3.062323  U— .2320777  X-  9.964314 

X-  .1808657  H-  .3264839  T-  12940.83  E-  .6092004  R-  3.062938  U— .2295887  X-  9.855028 

X-  .1851401  H-  .3264177  T-  12939.66  E-  .609019  R-  3.063559  U— .2271002  X-  9.745753 

X-  .189414  H-  .3263508  T-  12938.48  E-  .6088358  R-  3.064188  U— .2246122  X-  9.63649 

X-  .1936874  H-  .3262832  T-  12937.29  E-  .6086507  R-  3.064823  U— .2221247  X-  9.527237 

X-  .1979605  H-  .3262148  T-  12936.08  E-  .6084636  R-  3.065465  U— .2196378  X-  9.417996 

X-  .202233  H-  .3261457  T-  12934.86  E-  .6082745  R-  3.066114  U— .2171513  X-  9.308766 
X-  .2065052  H-  .3260759  T-  12933.63  E-  .6080834  R-  3.06677  U— .2146655  X-  9.199548 

X-  .2107768  H-  .3260054  T-  12932.38  E-  .6078902  R-  3.067434  U— .2121802  X-  9.090343 

, X-  .215048  H-  .325934  T-  12931.13  E-  .6076949  R-  3.068106  U— .2096954  X-  8.981148 
I X-  .2193187  H-  .3258619  T-  12929.85  E-  .6074974  R-  3.068785  U— .2072112  X-  8.871965 

X-  .223589  H-  .3257889  T-  12928.56  E-  .6072977  R-  3.069472  U— .2047276  X-  8.762795 

X-  .2278588  H-  .3257151  T-  12927.26  E-  .6070957  R-  3.070168  U— .2022445  X-  8.653637 
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X-  .2321281  H-  .3256405  T-  12925.94  E-  .6068913  R-  3.070871  U— .1997621  X-  8.544492 

X-  .2363968  H-  .325565  T-  12924.61  E-  .6066847  R-  3.071583  U— .1972802  X-  8.435359 

X-  .2406651  H-  .3254886  T-  12923.25  E-  .6064755  R-  3.072304  U— .1947989  X-  8.32624 

X-  .2449329  H-  .3254112  T-  12921.89  E-  .6062637  R-  3.073035  U— .1923182  X-  8.217133 

X-  .2492002  H-  .3253329  T-  12920.5  E-  .6060494  R-  3.073774  U— .1898381  X-  8.108038 

X-  .253467  H-  .3252537  T-  12919.1  E-  .6058323  R-  3.074523  U— .1873586  X-  7.998957 


■ 

.2577332 

H- 

.3251734 

T-  12917.68 

E- 

.6056128 

R-  3.075282 

U- 

-.1848798 

X- 

7.88989 

■ X- 

.2619989 

H- 

.3250922 

T-  12916.24 

E- 

.6053903 

R-  3.076051 

U- 

-.1824016 

X- 

7.780836 

X- 

.2662641 

H- 

.3250099 

T-  12914.78 

E- 

.6051649 

R-  3.07683 

U— 

.179924  X-  7, 

.671795 

H X-* 

.2705287 

H- 

.3249265 

T-  12913.31 

E- 

.6049367 

R-  3.077619 

u- 

-.1774471 

X- 

7.562769 

1 x~ 

.2747928 

H- 

.324842 

T-  12911.81 

E-  . 

6047053 

R-  3.07842  U 

-- . 

1749708  X-  7, 

.453756 

1 

.2790563 

H- 

.3247563 

T-  12910.29 

E- 

.6044708 

R-  3.079232 

u- 

-.1724951 

X- 

7.344758 

X- 

.2833193 

H- 

.3246696 

T-  12908.75 

E- 

.6042333 

R-  3.080055 

u- 

-.1700202 

X- 

7.235775 

X- 

.2875816 

H- 

.3245816 

T-  12907.19 

E- 

.6039925 

R-  3.080889 

u- 

-.1675459 

X- 

7.126806 

■ X- 

.2918434 

H- 

.3244924 

T-  12905.61 

E- 

.6037483 

R-  3.081736 

u- 

-.1650723 

X- 

7.017852 

1 

.2961046 

H- 

.3244019 

T-  12904.01 

E- 

.6035004 

R-  3.082597 

u- 

-.1625994 

X- 

6.908913 

X-  .3003653  H-  .32431  T-  12902.38  E-  .6032491  R-  3.083469  0— .1601272  X-  6.799989 

X-  .3046253  H-  .3242169  T-  12900.72  E-  .602994  R-  3.084355  U— .1576557  X-  6.691081 

X-  .3088847  H-  .3241223  T-  12899.04  E-  .6027352  R-  3.085255  U— .155185  X-  6.582188 

X-  .3131434  H-  .3240263  T-  12897.33  E-  .6024725  R-  3.086169  U— .152715  X-  6.473312 

X-  .3174015  H-  .3239288  T-  12895.6  E-  .6022055  R-  3.087098  U— .1502457  X-  6.364452 

X-  .321659  H-  .3238298  T-  12893.84  E-  .6019345  R-  3.088042  U— .1477772  X-  6.255609 

X-  .3259158  H-  .3237293  T-  12892.05  E-  .6016592  R-  3.089001  U— .1453095  X-  6.146782 

X-  .330172  H-  .3236271  T-  12890.24  E-  .6013793  R-  3.089977  U— .1428426  X-  6.037972 
X-  .3344274  H-  .3235232  T-  12888.39  E-  .601095  R-  3.090969  U— .1403764  X-  5.92918 

X-  .3386822  H-  ..  3234175  T-  12886.51  E-.  6008056  R-  3.091979  U— .1379111  X-  5.820405 

X-  .3429363  H-  .32331  T-  12884.59  E-  .6005114  R-  3.093007  U— .1354465  X-  5.711648 

X-  .3471897  H-  .3232006  T-  12882.64  E-  .6002119  R-  3.094054  U— .1329829  X-  5.602909 

X-  .3514423  H-  .3230893  T-  12880.66  E-  .5999072  R-  3.095119  U— .13052  X-  5.494189 

X-  .3556942  H-  .322976  T-  12878.64  E-  .5995969  R-  3.096206  U— .1280581  X-  5.385488 

X-  .3599454  H-  .3228605  T-  12876.58  E-  .5992808  R-  3.097313  U— .1255969  X-  5.276805 

X-  .3641958  H-  .3227428  T-  12874.48  E-  .5989587  R-  3.098442  U— .1231367  X-  5.168143 

X-  .3684454  H-  .3226229  T-  12872.34  E-  .5986304  R-  3.099594  U— .1206774  X-  5.059501 

X-  .3726942  H-  .3225006  T-  12870.15  E-  .5982955  R-  3.10077  U— .118219  X-  4.95088 

X-  .3769422  H-  .3223758  T-  12867.92  E-  .5979539  R-  3.10197  U— .1157616  X-  4.842278 

X-  .3811893  H-  .3222484  T-  12865.65  E-  .5976052  R-  3.103196  U— .1133051  X-  4.733698 

X-  .3854357  H-  .3221183  T-  12863.32  E-  .5972491  R-  3.104449  V— .1108496  X-  4.62514 

X-  .3896811  H-  .3219854  T-  12860.94  E-  .5968852  R-  3.105731  U— .1083951  X-  4.516604 

X-  .3939257  H-  .3218496  T-  12858.51  E-  .5965135  R-  3.107041  U— .1059416  X-  4.408091 

X-  .3981693  H-  .3217107  T-  12856.02  E-  .5961331  R-  3.108383  U— .1034891  X-  4.2996 

X-  .4024121  H-  .3215685  T-  12853.47  E-. 5957438  R-  3.109758  U— .1010377  X-  4.191134 

X-  .4066539  H-  .3214229  T-  12850.87  E-  .5953452  R-  3.111166  U— 9 . 858742E-02  X-  4.082691 

X-  .4108947  H-  .3212737  T-  12848.19  E-  .5949368  R-  3.112611  U— .0961382  X-  3.974274 

X-  .4151345  H-  .3211207  T-  12845.44  E-  .5945179  R-  3.114094  U— .0936901  X-  3.865881 

X-  .4193733  H-  .3209637  T-  12842.63  E-  .594088  R-  3.115618  U— 9.124316E-02  X-  3.757516 

X-  .423611  H-  .3208024  T-  12839.73  E-  .5936465  R-  3.117184  U— 8 . 879738E-02  X-  3.649177 

X-  .4278477  H-  .3206366  T-  12836.75  E-  .5931926  R-  3.118796  U— .0863528  X-  3.540865 

X-  .4320832  H-  .320466  T-  12833.68  E-  .5927258  R-  3.120456  U--8 . 390945E-02  X-  3.432583 

X-  .4363176  H-  .3202904  T-  12830.52  E-  .5922448  R-  3.122167  U— 8. 146736E-02  X-  3.324329 

X-  .4405508  H-  .3201092  T-  12827.26  E-  .5917488  R-  3.123934  U--7 . 902654E-02  X-  3.216106 

X-  .4447829  H-  .3199221  T-  12823.89  E-  .5912367  R-  3.125761  U— 7 . 658699E-02  X-  3.107913 

X-  .4490136  H-  .3197285  T-  12820.4  E-  .5907068  R-  3.127653  U— 7.414875E-02  X-  2.999753 

X-  .453243  H-  .3195278  T-  12816.78  E-  .5901573  R-  3.129618  U— 7 . 171182E-02  X-  2.891626 

X-  .4574711  H-  .319319  T-  12813.01  E-. 5895855  R-  3.131665  U— 6 .927611E-02  X-  2.783533 

X-  .4616978  H-  .3191006  T-  12809.06  E-  .5889877  R-  3.133808  U— 6 . 684156E-02  X-  2.675477 

X-  .465923  H-  .3188706  T-  12804.9  E-  .5883581  R-  3.136068  U— .0644079  X-  2.567459 
X-  .4701466  H-  .3186257  T-  12800.47  E-  .5876877  R-  3.138479  U— .0619748  X-  2.459481 

X-  .4743685  H-  .3183609  T-  12795.68  E-  .5869626  R-  3.14109  U— 5 . 954162E-02  X-  2.351547 

X-  .4785886  H-  .3180681  T-  12790.37  E-  .586161  R-  3.143981  U— 5 . 710737E-02  X-  2.243659 

X-  .4828066  H-  .3177349  T-  12784.32  E-  .5852489  R-  3.147278  U— 5 . 467056E-02  X-  2.135824 


j X-  .4870222  H-  .3173423  T-  12777.19  E-  .5841743  R-  3.151171  U— 5 . 222899E-02  X-  2.028052 

X-  .4912349  H-  .316862  T-  12768.45  E-  .5828592  R-  3.155948  U— 4 . 977947E-02  X-  1.920353 

| X-  .495444  H-  .3162521  T-  12757.33  E-  .5811897  R-  3.162034  U— 4 . 731777E-02  X-  1.812747 

X-  .4996484  H-  .3154532  T-  12742.73  E-  .5790026  R-  3.170042  U— 4 . 483832E-02  X-  1.70526 

X-  .5038465  H-  .3143824  T-  12723.09  E-  .5760713  R-  3.180839  U— 4 . 233421E-02  X-  1.597934 

X-  .5080363  H-  .3129279  T-  12696.31  E-  .5720894  R-  3.195624  U— 3 . 979735E-02  X-  1.490822 

X-  .5122145  H-  .3109429  T-  12659.53  E-  .5666552  R-  3.216025  U— 3 . 721874E-02  X-  1.384003 

X-  .516377  H-  .3082411  T-  12609.06  E-  .5592588  R-  3.244214  U— 3 .458936E-02  X-  1.277589 

X-  .5205181  H-  .304594  T-  12540.16  E-  .5492743  R-  3.283059  U— 3 . 190143E-02  X-  1.171721 

X-  .5246303  H-  .299731  T-  12446.91  E-  .5359615  R-  3.336325  U-- 2 . 914985E-02  X-  1.06659 

X-  .528704  H-  .2933452  T-  12321.97  E-  .5184798  R-  3.408953  U— 2 . 633427E-02  X-  .9624441 

X-  .5327272  H-  .2851036  T-  12156.41  E-  .4959175  R-  3.507497  U— 2 . 346151E-02  X-  .85959 

X-  .5366849  H-  .2746641  T-  11939.38  E-  .4673384  R-  3.64081  U--2 . 054768E-02  X-  .7584121 

X-  .5405587  H-  .2616991  T-  11657.79  E-  .4318454  R-  3.821182  U— 1 . 762001E-02  X-  .6593767 

X-  .5443271  H-  .2459231  T-  11295.74  E-  .3886571  R-  4.066311  U— 1 .471805E-02  X-  .5630354 

X-  .5479647  H-  .2271244  T-  10833.77  E-  .3371938  R-  4.402873  U— 1. 189385E-02  X-  .4700403 

X-  .5514418  H-  .2051959  T-  10247.85  E-  .2771623  R-  4.873392  U— 9 . 210446E-03  X-  .3811474 

X-  .5547239  H-  .1801624  T-  9507.817  E-  .2086305  R-  5.550548  U— 6 . 739009E-03  X-  .2972403 

X-  .5577708  H-  .1522  T-  8575.265  E-  .1320806  R-  6.570303  U— 4 . 554446E-03  X-  .2193447 
X-  .5605347  H-  .1216437  T-  7400.493  E-  4.842985E-02  R-  8.220727  U— 2 . 730065E-03  X-  .148685 

X-  .562955  H-  8.898176E-02  T-  5918.152  E— 4 . 098555E-02  R-  11.23826  U— 1 . 331357E-03  X-  8.68 
X-  .5649468  H-  5.483396E-02  T-  4040.891  E— .1344686  R-  18.23687  U— 4 . 102183E-04  X-  3.58887 

X-  .5663506  H-  .0199174  T-  1650  E— .2300561  R-  50.20735  U-  0 X-  0 
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SUMMARY  OUTPUT 
Output  -from  -file  SAMP.HT 


The  line  below  "Q.C  = " is  radiative  heating  -from  the  individual  bands  o-f  the 
eight  step  model.  The  order  here  corresponds  to  Olstad's  original  numbering 
scheme,  which  is  slightly  di-f-ferent  than  that  presented  in  AIAA  Paper  88-2672.  I. 
E. 


Bands 

AIAA  88-2672 
1 


4 

5 

6 
7 


Olstad 

1 

2 

3 

4 

6 

7 

5 


Wavelength  (A) 
400-852 
852-911 
911-1020 
1020-1130 
1130-1801 
1130-1801 
1801-4000 
4000- 


I ncl udes 
VUV  Continuum 


VUV  Continuum 
VUV  Continuum 
VUV  Continuum 
Continuum  + Line  Wings 
Line  "Centers" 

"Vi si bl e" 


Visible  + Infrared 


In  the  output  VUV  is  bands  1-4,  VUV  lines  is  bands  5-6  (6-7  in  Olstad's  numbers), 
nad  V1S+IR  is  bands  7 and  8 (5  and  8 in  Olstad's  scheme). 


Ul-  1600000  PI-  24.897 

T2-  13053.98  E2-  .6271315 

SI-  9 . 189011E- 17  S2—  1.345287E-21 

Bl-  4 . 794425E+08  B2-  4.260638E+11 

XR-  .8430347  L-  25.56528 

N-  3 Tl-  200.15 

TW-  1650  PLOT  TMAX-  50000 

PLOT  EPS  MAX-  1-0 

E2-  .6271315  EQ-  .6101499 

IM-  100  DTAU-  .075  XS-  14.47891 

RB  - 230 

QC-  133.1875  WATTS/SQ  CM 

34.29741  81.80688  291.3677  198.9687  63.1825  296.8814  3.33415  213.7095 

VUV  606.4407 
VUV  LINES  300.2155 
VIS+IR  276.8921  QRTOT-  1183.548 


SCREEN  PLOT 
Output  ot  tile  SAMP.BAS 
Retrievable  by  PL0TPIC.3AS 


QC=  133.1875  WATTS/'SQ  CM 

UUU  = 606.4407  XS=  14.47891 

LINE  REGION  = 300.2155  RB  = 230 

UIS  AND  IR  = 276.8921  QRT OT  = 1183 

ANOTHER  CALCULATION?  7 OR  N?  N 


% : 
A 


\ 
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The  AFE  Programs 

Inverse  Programs  -for  Computing  Nonequilibrium  Inviscid  Radiating  Flow-fields 

about  Blunt  Bodies 

Developed  by 

Leland  A.  Carlson,  Glenn  J.  Bobskill,  and  Robert  B.  Greendyke 


429 


USER  INSTRUCTIONS  AND  COMMENTS 


The  nonequilibrium  inviscid  inverse  codes  developed  as  part  of  this  project 
are  all  modifications  of  a code  originally  developed  by  William  L.  Grose  of  the 
NASA  Langley  Research  Center  and  described  in  NASA  TN  D-6529,  "A  Thin  Shock 
Layer  Solution  for  Nonequilibrium,  Inviscid,  Hypersonic  Flows  in  Earth,  Martian, 
and  Venusian  Atmospheres",  December  1971.  Several  different  versions  of  these 
new  codes  have  been  created,  and  some  of  these  are  still  in  a state  of 
development.  In  addition,  since  these  codes  were  developed  by  several 
individuals  over  several  years,  they  are  not  as  general  as  originally  hoped. 
Whenever  possible,  the  non-general  features  of  the  various  codes  will  be  pointed 
out  as  part  of  this  appendix . 

♦ 

It  should  be  noted  that  various  versions  of  the  codes  were  developed 
corresponding  to  different  chemical  and  electron  temperature  models.  In 
addition,  for  each  physical  model,  two  different  codes  were  developed.  The  first, 
which  is  termed  the  mainframe  version,  was  specifically  coded  for  the  IBM  3090 
and  is  a completely  integrated  code  with  many  output  files  for  graphics,  etc.  The 
second,  called  the  microcomputer  version,  was  coded  for  an  AT  compatible  and 
actually  consists  of  three  separate  parts.  The  first  part  sets  up  user  selected 
input  parameters  via  keyboard  input  and  reads  input  files.  The  second  part 
computes  the  chemically  reacting  nonequilibrium  flowfield  and  creates  outputfiles 
necessary  for  the  radiation  calculations,  and  the  third  part  computes  the 
radiative  heat  transfer  from  the  computed  flowfield.  The  last  part  can  be  run 
separately  as  long  as  the  input  files  associated  with  a given  flowfield  are 
available.  By  making  changes  in  these  files  of  the  input  parameters  controlling 
various  options,  the  radiative  heat  transfer  associated  with  various  electron 
temperature  and  radiation  models  can  be  computed  for  a variety  of  cases  very 
rapidly.  This  feature  is  very  advantageous  when  studying  various  radiation  and 
electron  temperature  models.  The  microcomputer  version  could  easily  be  used  on 
a mainframe  machine. 

In  general,  the  input  data,  variable  names,  etc.  are  those  used  originally  in 
NASA  TN  D-6529;  and  the  user  is  referred  to  that  document  for  details.  As  in 
the  orginal  NASA  version,  the  shock  shape  is  hard  coded  in  the  program.  In  the 
present  versions,  the  shock  shape  corresponds  approximately  to  that  for  a 60 
degree  hyperboloid  or  sphere  cone  body  having  a nose  radius  of  about  230  cm.  For 
different  body  shapes,  the  shock  shape  equation  would  have  to  be  changed. 
Further,  since  the  method  is  an  inverse  thin  shock  layer  method,  its  computed 
body  shape  will  be  "inaccurate"  in  the  immediate  vicinity  of  the  stagnation  point; 
and  for  very  blunt  bodies  the  sonic  line  far  away  from  the  stagnation  point  will 
not  be  accurately  located.  However,  for  the  regions  discussed  in  the  publications 
associated  with  this  project,  the  method  should  be  very  accurate. 

As  indicated,  the  present  codes  are  modifications  of  the  original  Grose  code. 
While  they  retain  the  ability  to  handle  up  to  25  species  and  25  forward-reverse 
reactions  (counted  as  50  separate  reactions  by  the  codes),  and  reaction  rates  and 
the  reactions  themselves  can  be  modified  via  the  input  data,  some  changes  have 
been  introduced.  Normally,  the  present  codes  assume  the  use  of  10  species  and 
11  forward-backward  reactions  and  the  ordering  of  these  species  and  reactions 
should  be  considered  fixed  without  extensive  and  careful  checking  of  the  code. 


For  example,  species  number  1 must  be  N2  and  species  8 must  be  N2+.  Also,  if 
included  reaction  10  (j=19  and  20  in  the  code)  must  be  the  nitrogen  electron  impact 
ionization  reaction  N + e = N+  + 2e  in  all  versions.  In  some  versions  of  the  code, 
reaction  11  <j=21  and  22)  must  be  the  corresponding  oxygen  electron  impact 
ionization  reaction.  Note  that  the  ordering  o-f  the  reactions  in  the  code  is  not 
that  which  was  given  in  AIAA  Paper  88-2673.  The  actual  reactions  used  in  any 
version  o-f  the  code  can  be  easily  determined  by  looking  at  the  corresponding  input 
data. 

One  o-f  the  modifications  included  in  all  versions  o-f  the  code  is  the  ability  to 
compute  either  an  entire  -flow-field  or  a "partial  -flow-field".  For  the  entire 
flow-field  situation,  both  the  mainframe  and  microcomputer  versions  normally  use 
twenty  streamlines.  However,  in  some  cases,  in  order  to  resolve  the  flowfield  in 
more  detail  and  permit  more  accurate  radiation  calculations,  additional 
streamlines  are  needed.  Thus,  the  mainframe  version  can  also  handle  forty 
streamlines.  Because  of  some  internal  coding,  the  number  of  streamlines  must 
either  be  20  or  40.  This  variable  is  the  first  variable  on  the  second  line  of  the 
detailed  input  file. 

In  should  be  noted  that  one  of  the  input  variables  is  NSR,  the  number  of 
streamlines  in  the  "stagnation  region",  defined  as  the  region  between  X=0  and 
X=DELX  along  the  shock  wave.  As  descibed  in  NASA  TN  D-6529,  Grose  normally 
used  NSR=5.  However,  for  the  present  studies  it  was  found  that  NSR=3  was 
adequate.  Since  there  is  a possibility  of  some  internal  hard  coding  depending 
upon  this  value,  it  should  be  kept  at  a value  of  three  without  careful  checking  of 
the  code.  With  this  value,  streamline  number  four  is  computed  twice.  The  first 
corresponds  to  the  body,  while  the  second  is  for  the  streamlaine  crossing  the 
shock  wave  at  DELX.  After  that,  streamlines  are  computed  starting  at  DELX  and 
then  proceeding  in  DELX  increments  along  the  shock  wave. 

For  the  "partial  flowfield"  option,  the  user  can  select  six  streamlines  to  be 
actually  computed.  Of  these  the  first  two  must  be  less  than  NSR+i  and  the 
remaining  four  larger.  The  partial  flowfield  option  is  very  useful  for  making 
rapid  nonequilibrium  chemistry,  electron  temperature,  and  vibration  dissociation 
coupling  studies.  However,  since  it  does  not  compute  a detailed  flowfield,  its 
results  cannot  be  used  to  compute  radiative  heat  transfer. 

Another  modification  included  in  all  versions  of  the  codes  is  the  option  to 
select  from  several  vibration  dissociation  coupling  models.  The  options  available 
are  vibrational  equilibrium,  CVD  coupling,  CVDV  coupling,  CVBV  preferential 
coupling*  and  the  new  MCVDV  model.  Further  details  concerning  these  models  and 
examples  of  their  similarities  and  differences  are  presented  in  AIAA  Paper 
88-2673  and  in  the  detailed  results  contained  in  Appendix  3.  For  all  the 
nonequilibrium  options,  the  user  also  has  the  choice  to  select  either  Millikan  and 
White  vibrational  relaxation  data  for  N2  and  N2+  or  the  data  included  in  the  input 
files.  For  unknown  reasons,  the  Millikan  and  White  correlations  were  hard  coded 
into  the  program,  which  is  why  N2  must  be  species  number  i and  N2+  must  be 
species  eight.  It  is  recommended  that  the  Millikan  and  White  data  always  be 
used.  Further,  based  upon  the  studies  of  this  project,  the  MCVDV  and  CVDV 
models  are  probably  the  most  robust  and  "realistic".  It  should  be  noted  that  the 
CVDV  preferential  model,  while  theoretically  sound,  is  computationally  intensive. 
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The  various  codes  also  contain  options  concerning  the  shock  Jump  conditions. 
The  rationale*  possible  usage*  and  some  results  -for  these  various  options  are 
discussed  in  the  thesis  by  Robert  Greendyke;  but*  in  general*  these  options  have 
not  been  thoroughly  tested.  Thus*  it  is  suggested  that  only  the  frozen  -flow  shock 
jump  option  (IQ3  = i)  be  utilized  without  further  investigation. 

Another  major  modification  to  the  original  Grose  code  is  the  inclusion  of 
radiation  models  and  the  computation  of  radiative  heat  transfer  to  the  vehicle. 
These  calculations  are  performed  after  the  chemically  reacting  blunt  body 
flowfield  has  been  obtained.  However*  the  flowfield  portion  has  been  modified  to 
trap  and  appropriately  store  flowfield  properties  at  the  locations  where  the 
streamlines  cross  the  X grid  lines.  Then  in  the  radiation  portion  of  the  new 
codes,  the  tangent  slab  approximation  is  utilized  to  compute  the  radiation  to  the 
vehicle.  In  the  mainframe  version*  the  user  has  the  option  to  select  various 
radiative  heat  transfer  (absorption  coefficient)  models  for  the  non-gray 
absorbing-emitting  computation  of  the  heating.  These  models  are  described  in 
AIAA  Paper  88-2673  and  the  thesis  of  Robert  Greendyke,  and  it  is  believed  that 
the  best  of  these  models  is  the  eight  step  absorption  coefficient  model. 
Consequently,  because  of  memory  limitations,  the  microcomputer  version  only 
includes  the  eight  step  model.  Further*  several  of  the  models  contain  a modified 
eight  step  model  slightly  different  from  that  used  in  AIAA  88-2673.  These  later 
modifications  were  introduced  in  order  to  yield  better  agreement  with  the 
detailed  radiation  model  RADICAL  (NASA  CR-1656). 

It  should  be  noted  that  in  the  programs  and  their  output  that  the  numbering  of 
the  bands  or  steps  is  different  for  the  eight  step  model  than  that  presented  in 
AIAA  88-2673.  The  relationship  is  as  follows: 


AIAA  88-2673  Band 

Program  Band 

Wavelength  (A) 

1 

1 

400-852 

2 

2 

852-911 

3 

3 

911-1020 

4 

4 

1020-1130 

5 

6 

1130-1801 

6 

7 

1130-1801 

7 

5 

1801-4000 

8 

8 

4000- 

The  radiation  portion  of  the  new  programs  also  contains  various  options  to 
handle  nonequilibrium  effects  on  radiative  heating.  Basically*  nonequilibrium 
effects  are  accounted  for  by  "correction  factors"  which  are  computed  as  functions 
of  temperature  and  composition.  Corrections  on  atomic  radiation  are  controlled 
by  the  input  variable  IQ5  (Yes  = 0*  No  = 1)  and  those  on  molecular  radiation  are 
selected  via  IQS  (Yes  = 0*  No  = 1).  In  addition,  in  some  versions  of  the  codes,  the 
user  can  also  select  whether  the  molecular  corrections  should  be  computed  using 
translational  temperature  (IQ.6=i)  or  electron  temperature  (IQ6=0).  Note  that  in 
early  versions  of  the  codes  (AFE2  and  AFEM)  molecular  corrections  cannot  be 
selected  without  also  selecting  atomic  corrections.  In  the  later  versions  which 


compute  electron  temperatures  independently  from  vibrational  temperatures# 
(AFETE  and  AFENEW)#  all  possible  combinations  of  IQ5  and  IQS  values  are 
permissible  with  the  eight  step  radiation  model.  (The  other  models  in  the 
mainframe  version  are  still  limited  in  that  molecular  corrections  can  only  be 
included  if  atomic  corrections  are  selected.) 

There  is  also  an  IQ9  = 0 option  which  gives  details  of  the  radiation  calculation 
at  each  point  in  the  program  for  each  wavelength  step.  This  option  is  only  used 
occassionally.  Also#  in  the  mainframe  versions  the  IS?  parameter  identifies 
which  streamline  for  which  all  flowfield  values  are  stored  for  subsequent 
graphical  output  of  the  variation  of  properties  along  the  streamline.  In  general# 
in  the  mainframe  version  the  body  and  shock  coordinates  are  also  stored  along 
with  those  for  the  selected  streamline.  Programs  to  produce  graphical  output 
from  these  files  have  been  written  and  utilize  the  TAMU  version  of  the  DISSPLA 
system.  While  not  included  in  this  report#  copies  will  be  provided  the  contractor 
upon  request. 


VERSIONS 

As  previously  mentioned#  in  general  there  are  for  each  flowfield  model  two 
versions  of  the  code  — one  corresponding  to  a mainframe  version  (IBM  3090)  and 
one  suitable  for  a micro  or  minicomputer  (VAX  or  AT  class).  The  latter  version 
could  easily  be  adapted  for  rapid  computations  on  a mainframe  machine. 

"Original  Version"  and  Modified  Version 


This  version  of  the  code  is  the  closest  of  the  existing  codes  to  that  which  was 
used  for  the  results  presented  in  AIAA.  Paper  88-2673.  It  assumes  that  the 
electron  tempeature  is  equal  to  the  nitrogen  vibrational  temperature  in  the 
radiation  calculations  and  in  all  chemical  rates  governed  by  electron  temperature. 
It  also  assumes  that  the  atomic  oxygen  ionization  reaction  involves  a general 
collision  partner#  M.  I.E.  0 + M = 0+  + e + M.  In  the  output  for  this  code#  at 
each  step  where  the  composition  and  flow  properties  are  printed#  values  are  also 
printed  for  two  electron  temperatures#  TE1  and  TE2.  These  were  "estimates" 
obtained  from  some  correlations  previously  developed  from  experimental  data  at 
lower  velocities  and  temperatures.  However#  for  the  conditions  of  interest  in  the 
present  study#  they  appear  to  be  inappropriate  and  should  be  ignored. 

The  microcomputer  version  consists  of  a series  of  programs  which  may  either 
be  executed  via  a batch  file  or  run  independently  sequentially.  The  first  of  these 
is  INPUT.  This  program  asks  the  user  for  a series  of  inputs  which  are  associated 
with  the  various  program  options  and  the  freestream  conditions.  This 
information  is  stored  in  a file  called  GEN. INPUT. 

The  second  program  in  the  sequence  is  AFE2.FOR#  which  reads  GEN.INPUT  and 
an  input  data  file  RR3.NUM.  The  last  name  is  arbitary  and  is  supplied  by  the  user 
during  the  execution  of  INPUT.  AFE2.FOR  computes  the  chemically  reacting 
nonequilibrium  flowfield  and  subsequently  creates  three  files,  RADIN1.DAT# 
RAD1N2.E)AT#  and  RAD1N3.BAT#  which  provide  the  data  needed  for  the  radiation 
calculation  by  the  third  program#  called  RAD. FOR.  This  latter  program  computes 


the  nongray  emitting  absorbing  radiative  -flux  to  the  wall  using  the  original  eight 
step  absorption  coefficient  model  described  in  AIAA  88-2673. 

The  modified  version  is  essentially  the  same  except  that  the  radiation 
program  is  replaced  by  the  program  RADMOD.FOR.  As  previously  discussed,  this 
modified  version  has  the  absorption  coefficients  for  VUV  lines  in  steps  6 and  7 
(program  numbering  scheme)  reduced  so  as  to  yield  better  agreement  with 
RADICAL.  The  changes  are  only  in  those  statements  which  compute  KAPPA(K,6,J> 
and  KAPPA(K,7,J). 

In  this  report,  only  the  listing  for  the  mainframe  version  of  the  modified  code 
is  included,  and  it  is  called  AFEM.  This  program  would  have  to  be  compiled  and 
executed  with  appropriate  job  control  language.  The  latter  must  set  up  input 
output  units  having  numbers  5,  6,  7,  8,  9,  10,  ii,  12,  13,  14,  15,  69,  70,  71,  72,  73, 
74,  and  75.  The  values  above  15  correspond  to  files  associated  with  storing  data 
for  later  retrieval  by  graphics  programs.  The  other  files  are  described  on  the 
first  page  of  the  listing.  The  input  to  the  program  is  provided  by  two  files.  The 
first,  called  SCREEN,  contains  the  user  selected  options  and  the  freestream 
conditions;  and  the  second,  identical  to  RR3.NUM,  contains  the  remaining  required 
input  data.  Note  that  in  the  listing  of  SCREEN  contained  in  this  report,  there  is 
a variable  10.10.  This  value  is  not  used  by  AFEM  and  should  be  deleted  when 
SCREEN  is  used  as  input  for  AFEM. 

"Three"  Temperature  Version 

This  version  has  essentially  been  developed  since  the  end  of  the  project,  but 
it  is  included  in  this  report  as  a matter  of  completeness.  Instead  of  assuming 
that  the  electron  temperature  is  equal  to  the  nitrogen  vibrational  temperature, 
this  model  computes  a separate  free  electron  temperature  using  a 
quasi-equilibrium  form  of  the  electron  energy  equation.  In  addition,  it  assumes 
that  atomic  ionization  due  to  electron  impact  occurs  as  a two  step  process;  and, 
thus,  it  uses  modified  reaction  chemistry  and  reaction  rates  based  upon  the 
experimental  work  of  Wilson.  Also,  the  nonequilibrium  radiation  correction 
factors  are  computed  in  this  version  by  a simpler,  although  equivalent,  scheme 
than  that  used  in  AFE2  and  AFEM.  (This  new  approach  is  based  upon  a 
suggestion  by  Robert  Greendyke  and  eliminates  the  need  to  compute  the 
equivalent  equilibrium  composition.  The  results  are  the  same,  however,  as  the 
previous  model.)  This  model  is  still  under  development  and  further  changes  may 
occur  in  the  future.  In  general,  this  model  is  probably  most  applicable  at  higher 
speeds  (U  > ii.5  km /sec)  where  significant  numbers  of  free  electrons  are  present. 
Results  obtained  with  this  model  and  the  theory  behind  its  development  will  be 
presented  in  a paper  at  the  June  1989  AIAA  Thermophysics  Conference. 

The  microcomputer  code  version  of  this  model  utilizes  the  programs 
INPUT. FOR,  AFETE.FOR,  and  RADNW1  .FOR  with  input  files  RR3W.NUM;  and  the 
mainframe  version  uses  AFENEW  with  input  files  SCREEN  and  KDRW.  In  SCREEN 
the  value  of  IQ10  determines  which  values  are  used  in  the  radiation  calculation. 
If  IQiO=i,  the  electron  temperature  is  determined  by  the  quasi-equilibrium 
approach.  If  10.10=0,  the  electron  temperature  is  assumed  to  be  equal  to  the 
nitrogen  vibrational  temperature.  In  both  cases,  the  electron  impact  ionization 
reactions  are  assumed  to  be  controlled  by  an  electron  temperature  determined  by 
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the  quasi-equilibrium  approach  -for  -free  electron  temperature.  It  should  be  noted 
that  in  AFETE.FOR  that  10.10  is  hard  coded  to  be  unity.  This  value,  ot  course, 
could  be  easily  changed.  In  addition,  since  the  value  o-f  IQ10  is  written  to  the  -file 
RADINi.DAT  by  AFETE.FOR  and  since  the  radiation  program  RADNW1.FOR  can  be 
run  independently,  the  value  o-f  10.10  can  be  changed  to  the  desired  value  in  the 
RADIN1  tile  by  the  user  prior  to  executing  RADNW1. 

Further,  AFENEW  and  RADNW1  both  allow  all  possible  combinations  ot 
options  on  usage  ot  the  radiation  correction  tactors  in  the  eight  step  model  as 
determined  by  the  values  ot  105  and  108.  Also,  in  the  output  at  each  printed 
tlowtield  point  in  AFENEW  and  AFETE,  the  value  printed  tor  TE1  is  the  electron 
temperature  determined  by  the  quasi-equilibrium  approach.  On  the  same  line,  is 
printed  a scaled  value  ot  the  local  electron  production  rate,  WE,  due  to  all 
reactions. 
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STATEMENT  LISTING  FOR  PROGRAM  INPUT.FOR 
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c 

C PROGRAM  WHICH  SUPPLIES  INPUT  DATA  FOR  PROGRAM  AFE2 . FOR 
C THROUGH  GEN. INPUT 
C 

REAL  RINPUT(6) 

INTEGER  IINPUT(15)  ,IS(6)  ORIGINAL  PAGE  l<S 

CHARACTER* 30  FILES  (4)  OF  POOR  QUALITY 

WRITE(* , 1) 

1 FORMAT (IX, 'PRINT  FREQUENCY 
READ(*,*)  I INPUT ( 1 ) 

WRITE(* , 2) 

2 FORMAT (IX, 'DO  YOU  WANT  TO  INPUT  AN  INITIAL  INTEGRATION  STEP  ?', 

*/,  IX,  'Yes  - 0 , No  - 1 ( 1 - Def.  Value  of  1 . 220703125E-04  ) : ' 

* > $) 

READ(*,*)  IAXI 
IF  (IAXI.EQ.l)  THEN 
RINPUT ( 1 ) - .0625/512.0 
GO  TO  4 
ENDIF 
WRITE(* ,3) 

3 FORMAT  (IX, 'INITIAL  INTEGRATION  STEP  ( XI.LE.0.5  ) - ',$) 

READ(*,*)  RINPUT(l) 

4 WRITE(*,6) 

6 FORMAT (IX, 'VIBRATIONAL  EQUILIBRIUM  ? Yes  - 0 , No  - 1 : ' ,$) 

READ(*,*)  IINPUT(2) 

WRITE(*,7) 

7 FORMAT (IX, 'ENTER  DELX  ALONG  SHOCK  (cm)  -',$) 

READ(*,*)  RINPUT (2) 

WRITE(*,8) 

8 FORMAT  (IX, 'NO.  OF  PSI  LINES  IN  THE  STAG.  REGION  (MAX-10)  - ',$) 

READ(*,*)  I INPUT (3) 

NSR1  - IINPUT(3)  + 1 
WRITE(*,9) 

9 FORMAT  (IX, 'LENGTH  OF  SYMMETRY  AXIS  , Z , (cm)  - ’,$) 

READ(*,*)  RINPUT ( 3 ) 

WRITE(* , 10) 

10  FORMAT (IX, 'DO  YOU  WANT  THE  FULL  FLOW  FIELD  SOLUTION  ?’,/, 

* 25X, 'Yes  - 0 , No  - 1 : ' ,$) 

■ READ(*,*)  I INPUT (4) 

IF  ( I INPUT ( 4 ) . EQ . 0 ) GO  TO  12 
WRITE(* , 11)  NSR1 

11  FORMAT (IX, 'ENTER  STRMLINE  NO.  1,2, 3, 4, 5, 6 FOR  INFO.  EXTRACTION' 

*,/,lX,'  1 < NO . 1 < NO. 2 < ' ,12,'  .LE.  NO. 3 < NO. 4 < NO. 5 < NO. 6 ' 

*,/,lX,'  - ',$) 

READ(*, *)  (IS (I) ,1-1,6) 

C 

12  IF  (IINPUT(2) .EQ.O)  GO  TO  15 
WRITE(* , 13) 

13  FORMAT  ( IX , 'DO  YOU  WANT  MILLIKAN  AND  WHITE  DATA  (N2 , N2+)  ?', 

*/, IX, 'Yes  - 1,  No  - 2 - ' ,$) 

READ(*,*)  IINPUT(5) 

WRITE(* , 14) 

14  F0RMAT(1X, 'VIBRATION-DISSOCIATION  COUPLING  MODELS  :',/, 

* IX, 'TYPE  : 1 FOR  CVD  MODEL' ,/,10X, '2' ,2X, 

* 'FOR  CVDV  MODEL  ( excluding  NO  and  NO+  ) ' ,/,10X,'3'f 

* 2X , ' FOR  CVDV-Pref . ( excluding  NO  and  NO+  ) ' ,/, 

* 10X, '4' ,2X, 'FOR  PARK  MODEL  ( vith  M&W  selected  ) - ',$) 

READ(* , *)  I INPUT (6) 

15  WRITE(* , 16) 


16  FORMAT (IX, 'SHOCK  JUMP  MODELS  : ' ,/, 

* IX, 'TYPE  : 1 FOR  FROZEN  FLOW  ACROSS  THE  SHOCK' ,/,8X, 

* ' 2 FOR  N2  FROZEN  AND  02  DISSOCIATING' ,/, 8X, 

* ' 3 FOR  N2  & 02  DISSOCIATING  - ',$) 

READ(*,*)  IINPUT(7) 

IF  (IINPUT(7).EQ.2.0R.IINPUT(7).EQ.3)  THEN 
WRITE (*,17) 

17  FORMAT ( IX, 'Tvib  - Tinf  (1)  OR  Tvib  - Ttrans  (2)  - ',$) 
READ(*,*)  IINPUT(8) 

WRITE(*,18) 

18  F0RMAT(1X, ' Tel  - Tinf  (1)  OR  Tel  - Ttrans  (2)  - ',$) 

READ(*,*)  IINPUT(9) 

ENDIF 

WRITE (*,19) 

19  FORMAT (IX, 'RADIATION  MODELS  :',/,lX, 


* 'TYPE  : 

0 

NO  MODEL  ' ,/,lX, 

* • 

1 

OLSTAD  MODEL  './.IX, 

* * 

2 

CARLSON  MODEL' ,/,lX, 

* ' 

3 

BOTH  MODELS' ,/, IX, 

* • 

4 

BOTH  MODELS  WITH  CAPTURED  VALUES 

READ(*,*)  IINPUT(IO) 

IF  (I INPUT (10) .NE. 0)  THEN 
WRITE(* , 20) 

20  FORMAT ( IX , ' QR  VALUES  AT  EACH  STEP  (Yes  - 0,No  - 1)  - ',$) 
READ(*,*)  IINPUT(15) 

WRITE(*,21) 

21  FORMAT  ( IX, 'NON- EQUIL.  CORR.  FOR  ATOMIC  RAD.  (Y-O.N-l)  - ',$) 
READ(*,*)  IINPUT(ll) • 

WRITE(*,22) 

22  FORMAT  (IX, 'NON -EQUIL.  CORR.  FOR  MOLECULAR  RAD.  (Y-O.N-l)  - ',$) 
READ(*,*)  I INPUT (14) 

IF  (IINPUT(14) .EQ.O)  THEN 
WRITE (*,23) 

23  FORMAT (IX, 'BETA  AS  A FUNCTION  OF  (Te  - 0,  Tt  - 1)  - ',$) 
READ(*,*)  IINPUT(13) 

ENDIF 

ENDIF 

WRITE(* , 24) 

24  FORMAT (IX, 'ENTER  STRLNE  NO.  FOR  DETAILED  CALC.  (None  - 0)  - ',$) 
READ(*,*)  IINPUT(12) 

WRITE(*,25) 

25  F0RMAT(1X, ' FREES TREAM  VELOCITY  (cm/sec)  - ',$) 

READ(* , *)  RINPUT(4) 

WRITE(*,26) 

26  FORMAT ( IX, 'FREESTREAM  PRESSURE  (dynes/cm**2)  - ' ,$) 

READ(*,*)  RINPUT(5) 

WRITE (*,27) 

27  FORMAT (IX, 'FREESTREAM  TEMPERATURE  ( K ) = ',$) 

READ(*,*)  RINPUT ( 6 ) 

WRITE(* , 30) 

30  FORMAT (IX, 'ENTER  NAME  OF  INPUT  DATA  FILE  : ',$) 

READ(* , 39)  FILES (1) 

WRITE(* , 32) 

32  FORMAT (IX, 'ENTER  NAME  OF  OUTPUT  DATA  FILE  : ',$) 

READ (*,39)  FILES (2) 

WRITE (*,34) 

34  FORMAT (IX, 'ENTER  NAME  OF  EVIS  OUTPUT  FILE  : ',$) 
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READ(* , 39)  FILES ( 3 ) 

IF  (IINPUT(IO) .GT.O)  WRITE(*, 35) 

35  FORMAT  (IX, 'ENTER  NAME  OF  RADIATION  OUTPUT  FILE  : ’,$) 

IF  (IINPUT(IO) .GT.O)  READ(*, 39)  FILES(4) 

39  FORMAT (A30) 

C 

OPEN  (UNIT-106,  FILE- 'GEN.  INPUT' .STATUS- 'UNKNOWN')  OR|G||\|/w 

WRITE(106  , *)  (IINPUT(I),  1-1,15)  OF  POOD 

WRITE ( 106 ,*)  (IS(I), 1-1,6) 

WRITE(106 ,*)  (RINPUT(I) ,1-1,6) 

IF  (IINPUT(IO) .EQ.O)  WRITE(106 , 70)  (FILES(I)  , 1-1 , 3) 

IF  (IINPUT(IO) .GT.O)  WRITE(106 ,75)  (FILES(I) ,1-1,4) 

70  FORMAT (1X,3(A30,2X)) 

75  FORMAT ( IX, 4 (A3 0 , 2X) ) 

CLOSE(106) 

END 
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PROGRAM  AFE2  ORIGINAL  PAGE  IS 

AN  INVERSE  HYPERSONIC  FLOW  SOLUTION  FOR  AN  AFE/AOTV  BODY  IN  OF  POOR  QUALITY 

CHEMICAL  NONEQUILIBRIUM  USING  VIBRATION- DISSOCIATION  COUPLING  MODELS, 

SHOCK  JUMP  APPROXIMATIONS,  ELECTRON  TEMPERATURE  MODELING,  AND 
UNCOUPLED  RADIANT  HEAT  TRANSFER  USING  A METHOD  DERIVED  BY  S.MASLEN 

BASED  ON  AN  ORIGINAL  PROGRAM  BY  B.L.  WEIGEL  FOR  WILLIAM  L.  GROSE 
VIRGINIA  POLYTECHNIC  INSTITUTE  - 1969,  (NASA  TN  D-6529,  DEC.  1971) 

PROGRAM  MODIFICATION  BY: 

TEXAS  A&M  UNIVERSITY 
DEPARTMENT  OF  AEROSPACE  ENGINEERING 
TAMRF-5671  (1987-1988) 

PRINCIPAL  INVESTAGATOR  : DR.  LELAND  A.  CARLSON 

RESEARCH  ASSISTANT  : GLENN  J.  BOBSKILL 

RESEARCH  ASSISTANT  : ROBERT  B.  GREENDYKE 


CALINTH  : INTEGRATION  ROUTINE  BY  CHARLES  E.  TREANOR 
THE  NUMERICAL  INTEGRATION  ALGORITHM  USED  IS  FOUND  IN  A METHOD 
FOR  THE  NUMERICAL  INTEGRATION  OF  COUPLED  FIRST  ORDER 
DIFFERENTIAL  EQUATIONS  WITH  GREATLY  DIFFERENT  TIME  CONSTANTS 

FOFE  - EVALUATE  E BY  NEWTON  ITERATION  METHOD 

FOFTS1  - EVALUATE  TS  BY  NEWTON  ITERATION  METHOD,  CHEMISTRY  FROZEN 
FOFTS23  - FOFTS1  WITH  N2  FROZEN,  02  DISSOCIATING  OR  BOTH  N2  & 02  DISS. 
FTLUP  - INTERPOLATION  ROUTINE 

DATA  FILES 


UNIT  7 IS  USED  FOR  THE  INPUT  DATA  FILE 
UNIT  8 IS  USED  FOR  THE  OUTPUT  DATA  FILE 

UNIT  9 IS  USED  TO  STORE  VIBRATIONAL  ENERGY  DATA  AT  THE  SHOCK  (FORMATTED) 

UNIT  10  IS  USED  TO  STORE  ALL  STAGNATION  QUANTITIES 

UNIT  11  IS  USED  TO  STORE  ALL  EVIS  DATA  FOR  COMPUTATIONAL  PURPOSES 

UNIT  12  IS  USED  TO  STORE  ALL  PRESSURE  DATA 

UNIT  13  IS  USED  TO  STORE  ALL  DPDX  DATA 

UNIT  14  IS  USED  TO  STORE  QUANTITIES  FOR  PHYSICAL  SPACE  CALCULATIONS 

UNIT  15  IS  USED  TO  STORE  QUANTITIES  FOR  RAD. FOR 

UNIT  16  IS  USED  TO  STORE  QUANTITIES  FOR  RAD. FOR 

UNIT  17  IS  USED  TO  STORE  QUANTITIES  FOR  RAD. FOR 

INPUT -NAMELIST 


DELX  - INCREMENT  ALONG  SHOCK  , cm 

ZSTERM  - LENGTH  OF  SYMMETRY  AXIS  , Z , cm 

IMAX  - MAX.  NO.  OF  I-S  SPECIES  , LESS  THAN  OR  EQUAL  TO  25 

JMAX  - MAX.  NO.  OF  J-S  REACTIONS  , LESS  THAN  OR  EQUAL  TO  50 

MJ  - CODE  INDICATING  WHICH  SPECIES  , I , TO  USE  TO  CALCULATE 

COUPLING  FACTOR,  PHI  SUB  J , FOR  REACTION  J 
M - 1 FOR  VIBRATIONAL  NON- EQUILIBRIUM 

- 0 FOR  VIBRATIONAL  EQUILIBRIUM 
R - UNIVERSAL  GAS  CONSTANT  , erg/ (mole -K) 

GAMMA  - RATIO  OF  SPECIFIC  HEATS 

Cl INF  - FREESTREAM  MASS  FRACTION  FOR  EACH  SPECIES 
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PINF 
TINF 
VINF 
MU  I 

THETAI 

DGENI 

FI 

DELHI 

DELI 

EVI 

BI 

LI 

GIL 

EPSIIL 

AJ 

BJ 

EJ 

DIRECT 

AIJ 

NUIJ 

NUPIJ 

ALP  IK 

BETAIK 

SIGIK 

NIP 

UP 

WE 

WEXE 

WEYE 

WEZE 

XI 

ELE1 

ELE2 

XPST 


NXPST 

CIMAX 

HCHCKT 

TCHCKT 

PHMAX 

IPF 


- FREESTREAM  PRESSURE  , dynes/cm**2 

- FREESTREAM  TEMPERATURE  , K 

- FREESTREAM  VELOCITY  , cm/sec 

- MOLECULAR  WT.  FOR  EACH  SPECIES  , gm/mole 

- CHARACTERI SIC  VIBRATIONAL  TEMPERATURE  , K 

- FUDGE  FACTOR  TO  PERMIT  APPROXIMATING  POLYATOMIC  MOLECULE 
BY  A DIATOMIC  MOLECULE 

- 0 FOR  MONATOMIC  SPECIES 

- 1 FOR  ALL  OTHERS 

- HEAT  OF  FORMATION  , ergs/mole 

- DISSOCIATION  ENERGY  OF  SPECIES  , K 

- VIBRATIONAL  ENERGY  OF  SPECIES  , ergs/g 

- 3/2*ln(2*PI*Mi*k/h**2)  + ln(k)  + FI (I )*ln (THETAI (Rotational) ) 

+ ln(GIL(I , 1) ) FOR  EACH  SPECIE  I 

- NUMBER  OF  ELECTRONIC  LEVELS  FOR  EACH  SPECIES  ( LI.LE.20  ) 

- DEGENERACY  OF  L-TH  ELECTRONIC  LEVEL  FOR  I-TH  SPECIES 

- L-TH  ELECTRONIC  ENERGY  LEVEL  FOR  I-TH  SPECIES  , K 

- FREQUENCY  FACTOR  IN  ARRENIUS  TYPE  RATE  EQN. 

- TEMPERATURE  EXPONENT  IN  ARRENIUS  TYPE  EQN. 

- ACTIVATION  ENERGY  IN  ARRENIUS  TYPE  EQN. 

- DIRECTION  OF  THE  REACTION  ( FORW.  - 1.0  , BACK.  - 2.0  ) 

- FACTOR  TO  ALLOW  USE  OF  GENERAL  SPECIES  IN  REACTION  EQNS . 

i.e.  (N2  + M - 2N  + M),  AIJ  - 1.0  OR  (N2  + 02  - 2NO) , AIJ  - 0.0 

- STOICHIOMETRIC  COEFFICIENTS  OF  I-TH  REACTANT  IN  J-TH  REACTION 

- STOICHIOMETRIC  COEFFICIENTS  FOR  I-TH  PRODUCT  IN  J-TH  REACTION 

- FACTORS  IN  EQN.  FOR  VIBRATIONAL  RELAXATION  TIME 

- FACTORS  IN  EQN.  FOR  VIBRATIONAL  RELAXATION  TIME 

- FACTORS  IN  EQN.  FOR  VIBRATIONAL  RELAXATION  TIME 

- NUMBER  OF  VIBRATIONAL  LEVELS  FOR  ANHARMONIC  OSCILLATOR  , K 

- CHARACTERISTIC  PROBABILITY  TEMPERATURE  , K 

- CONST.  USED  TO  COMPUTE  ANHARMONIC  OSCILLATOR  , K 

- CONST.  USED  TO  COMPUTE  ANHARMONIC  OSCILLATOR  , K 

- CONST.  USED  TO  COMPUTE  ANHARMONIC  OSCILLATOR  , K 

- CONST.  USED  TO  COMPUTE  ANHARMONIC  OSCILLATOR  , K 

- INITIAL  COMPUTING  INTERVAL  , .0001220703125  UNLESS  INPUT  , cm 

- (2*IMAX  + 1)  VALUES  USED  BY  INTEGRATION  SCHEME 
NORMALLY  0.1, 0.5,  OR  .05  , (UPPER  PH  RANGE) 

- (2*IMAX  + 1)  VALUES  USED  BY  INTEGRATION  SCHEME 
NORMALLY  . 05 , . I , OR  .01  AND  .LT.  ELE1  , (LOWER  PH  RANGE) 

- 99  OR  LESS  Xs  AT  WHICH  PHYSICAL  SPACE  CALCULATIONS  ARE 
DESIRED.  THEY  MUST  BE  MULTIPLES  OF  DELX  IN  ORDER  TO  HAVE 
RS , COST, ZS , AND  SINT  VALUES  AND  LAST  MUST  BE  .GT.  X AT 
ZSTERM.  THEREFORE,  XPST (NXPST)  SET  - X AT  ZSTERM  + 100.0 
IN  PROGRAM.  XPST (1)  MAY  NOT  BE  0 . 0 . THEREFORE,  SET 
XPST(l)  - DELX  IN  PROGRAM 

- NUMBER  OF  Xs  AT  WHICH  PHYSICAL  SPACE  CALCULATIONS  ARE 
DESIRED 

- MAX.  CJ  OR  COMPUTING  INTERVAL  0.0625  UNLESS  INPUT  OTHERWISE 

- CONTROL  ON  SIZE  OF  COMPUTING  INTERVAL  IN  CHECK 
IF (ABS (HPREV  - H) /H . GT . HCHECK)  REDUCE  INTERVAL 

- CONTROL  ON  SIZE  OF  COMPUTING  INTERVAL  IN  CHECK 
IF (ABS (TPREV  - T) /T . GT . TCHECK)  REDUCE  INTERVAL 

* CONTROL  ON  COMPUTING  INTERVAL  .LE.  65.0 

- OUTPUT  PRINT  FREQUENCY 


STOPS 


STOP  1 INCORRECT  INPUT 

STOP  2 IN  MAIN  WHEN  NXPST  IS  .LE.  2 

STOP  13  IN  SHOCKG 


c STOP  30  IN  CHECK  WHEN  COMPUTING  INTERVAL  .LT.  1.0E-15 

C STOP  66  IN  BASIC  WHEN  NO  CONVERGENCE  ON  E ITERATION  (FOFE) 

C STOP  301  IN  MAIN  FOR  ERROR  IN  XPST  ARRAY  OR  IZTERM  .GT.  200 

C STOP  321  IN  MAIN  WHEN  NO  CONVERGENCE  ON  TS  ITERATION  (FOFTS) 

C STOP  663  IN  MAIN  WHEN  X .NE.  VARI(IPSI) 

C STOP  665  IN  MAIN  AFTER  AN  INTEGRATION  ATTEMPT 

C STOP  670  IN  MAIN  WHEN  A Cl  NEGATIVE 

C 

C NOTE  : PROGRAM  IS  CURRENTLY  CONFIGURED  FOR  A MAXIMUM 
C 200  STREAMLINE  SOLUTION 

C 

IMPLICIT  REAL*8(A-H,0-Z) 

COMMON  /Al/  M, IX, IMAX, IPS I , MODEL , TE1 ,TE2 
COMMON  /A2/  P(200) ,DPDX(200) ,VARI(200) 

C FOLLOWING  7 VARIABLES  DIMENSIONED  BY  IMAX 

COMMON  /A3/  EVIINF(25) ,THETAI(25) ,MUI(25) ,FI(25) ,DELHI(25) , 

* CIINF(25) ,LI(25) 

COMMON  /A4/  R.MUINF, DELTA , LAMSQ , OMEGSQ , OMEGA, MU ,T,U,TINF 
C FOLLOWING  2 VARIABLES  DIMENSIONED  BY  (LMAX  IN  LI , IMAX) 

COMMON  /A5/  EPSIIL(20,25)  ,GIL(20,25) ,CID(200,4) 

COMMON  /A6/  VAR(52) ,CUVAR(52) ,DER(51) 

C FOLLOWING  4 VARIABLES  DIMENSIONED  BY  JMAX 

COMMON  /A7/  MJ(50) , EJ (50) ,AJ(50) ,BJ(50) , DIRECT (50) 

C FOLLOWING  3 VARIABLES  DIMENSIONED  BY  IMAX 

COMMON  /A8/  TVI(25),NI(25),DGENI(25),BI(25) 

C EVIS(IMAX) 

COMMON  /A9/  EVIS(25) ,XPST(100) 

C FOLLOWING  3 VARIABLES  DIMENSIONED  BY  (IMAX+1 , JMAX)  OR  (IMAX, JMAX) 

COMMON  /A10/  NUIJ (26,50) , AIJ (25,50) ,NUPIJ (25,50) 

C FOLLOWING  3 VARIABLES  DIMENSIONED  BY  (IMAX, JMAX) 

COMMON  /All/  SIGIK(25 ,25) , ALPIK(25 , 25) , BETAIK(25 ,25) 

COMMON  /A12/  SINTM(200) ,COSTM(200) ,RSM(200) ,RCM(200)  ,X1(200) 

* , ZSM(200) 

COMMON  /A13/  DELX.ZSTERM, IZTERM, NSR, MW, SP.TS 

COMMON  /A14/  EINF , PINF , RHOINF , VINF , E , JMAX , KEYINT , RHO , HSTAG 

COMMON  /A15/  PFTL,KITR1,NIP(25) ,UP(25) 

COMMON  /A16/  IUNEG,WE(25) ,WEXE(25) ,WEYE(25) ,WEZE(25) 

COMMON  /A17/  ELB , SPEC , CJ , TPREV , HPREV , HCHECK , TCHECK 

COMMON  /A18/  ITNEG , I EXP 

COMMON  /A19/  ELE1(51) ,ELE2(51) ,NERR 

C DELI (IMAX) 

DIMENSION  DELI (25) 

DIMENSION  RUT(200) , PSISTG(200) 

DIMENSION  CIG(25,11) ,EIG(25,11) 

DIMENSION  PSIG(ll) ,TG(11) ,HG(11) , CIT(ll) ,EIT(11) ,EG(11) 

C CM ( IMAX) , Cl (IMAX) ,EVI( IMAX) 

DIMENSION  CM(25) ,CI(25) ,EVI(25) 

EQUIVALENCE  (VAR(l) ,XVAR) , (VAR(2) ,H) , (VAR(3) , CI(1) ) 

REAL* 8 MUI , MUINF , MU , MINF , MINFSQ , LAMBDA , LAMSQ 
CHARACTER*30  INFILE , OUTFL1 , 0UTFL2 , OUTFL3 
CHARACTER*30  SPECIE (25) .REACT (50) 

C OPEN  GENERAL  INPUT  FILE  CREATED  BY  INPUT. FOR 

OPEN  (UNIT-106 , FILE- ' GEN . INPUT ' , STATUS- ' OLD ' ) 

C READ  INTERACTIVE  INPUTS  FROM  GEN. INPUT 

READ ( 106 , *)  IPF , M , NSR , IANS , MW , MODEL , IQ3 , IQ1 , IQ2 , IQ4 , 

* IQ5 , IQ7 , IQ6 , IQ8 , IQ9 
READ (106 ,*)  IS1,IS2,IS3,IS4,IS5,IS6 

READ ( 106 , *)  XI , DELX , ZSTERM , VINF , PINF , TINF 

IF  (IQ4.EQ.0)  READ (106, 20)  INFILE , 0UTFL1 , OUTFL2 

IF  (IQ4.GT.0)  READ (106 , 18)  INFILE , OUTFL1 , OUTFL2 , OUTFL3 


MM3 


18  FORMAT (IX, 4 (A30 , 2X) ) 

20  FORMAT ( IX , 3 ( A30 , 2X) ) 

CLOSE(106) 

NSR1  - NSR  + 1 

NERR  - 0 

ITNEG  - 0 

I EXP  - 0 

NEG  - 0 

IUNEG  - 0 

DO  21  I - 1,52 

VAR(I)  - 0.0 

CUVAR(I)  - 0.0 

IF  (I.EQ.52)  GO  TO  21 

DER(I)  - 0.0 

ELEl(I)  - 0.0 

ELE2 (I)  - 0.0 

21  CONTINUE 

OPEN  (UNIT-7 , FILE-INFILE , STATUS- ' OLD ' ) 

OPEN  (UNIT-8 , FILE-OUTFL1 , STATUS- ' UNKNOWN ' ) 

OPEN  (UNIT-15 , FILE- ' RADIN1 . DAT ' , STATUS- ' UNKNOWN ' ) 

READ  INPUT 

READ(7 ,*)  IMAX,JMAX,R, GAMMA 
READ(7 , *)  NXPST , CIMAX , PHMAX , TCHCKT , HCHCKT 
NXCON  - NXPST  - 1 
WRITE (15, 40)  OUTFL3 
40  FORMAT (A3 0) 

WRITE ( 15 , *)  MODEL , IQ3 , VINF , PINF , TINF 

WRITE ( 15 , *)  NXPST , NXCON , IMAX , IQ4 , IQ5 , IQ6 , IQ8 , IQ9 

DO  42  I - 1 , IMAX 

READ(7 ,*)  THETAI ( I ) ,MUI(I) ,FI(I) ,DELHI(I) ,CIINF(I) ,LI(I) ,DGENI(I) 

* , DELI (I) ,EVI(I) ,BI(I) 

42  WRITE(15 ,*)  MUI(I) 

DO  45  J - 1, JMAX.2 

45  READ (7 ,*)  MJ(J) ,AJ(J) ,BJ(J) ,EJ(J) , DIRECT ( J ) 

DO  48  J - 2 , JMAX, 2 
48  READ ( 7 , * ) MJ(J) ,DIRECT(J) 

IMAX21  - 2*IMAX  + 1 
DO  51  I - 1 , IMAX21 
51  READ ( 7 , * ) ELE1 ( I ) , ELE2 ( I ) 

DO  54  I - 1 , IMAX 

54  READ ( 7 , * ) (AIJ(I,J),J  - l.JMAX) 

DO  57  J - l.JMAX 

57  READ ( 7 , * ) (NUIJ(I,J) ,1  - l.IMAX+l) 

DO  60  J - l.JMAX 

60  READ ( 7 , * ) (NUPIJ (I , J) , I - l.IMAX) 

DO  63  I - 1 , IMAX 

63  READ ( 7 , * ) (ALPIK(J.I) ,J  - l.IMAX) 

DO  66  I - l.IMAX 

66  READ(7,*)  (BETAIK(J.I) ,J  - l.IMAX) 

DO  69  I - l.IMAX 

69  READ ( 7 , * ) (SIGIK(J , I) ,J  - l.IMAX) 

DO  72  I - l.IMAX 
LI  I - LI  (I) 

WRITE(15 , *)  LI I 

READ(7 , *)  (GIL(L, I) . L - l.LII) 

72  WRITE(15 , *)  (GIL(L.I) ,L  - l.LII) 

DO  75  I - l.IMAX 
LI I - LI (I) 

WRITE(15 ,*)  LI I 

READ ( 7 , * ) (EPSIIL(L.I) ,L  - l.LII) 


75  WRITE(15 ,*)  (EPSIIL(L.I) ,L  - l.LII) 

IF  (IANS.EQ.l)  THEN 

NXPST  - 4 

XPST(l)  - (IS3  - NSR)*DELX 
XPST(2)  - (IS4  - NSR)*DELX 
XPST(3)  - (IS5  - NSR)*DELX 
XPST(4)  - (IS6  - NSR)*DELX 
GO  TO  78 
ENDIF 

DO  76  I - 1, NXPST 
XPST(I)  - DELX*I 

76  WRITE (15 , *)  I ,XPST(I) 

78  DO  80  I - l.IMAX 

80  READ ( 7 , * ) NIP(I),UP(I),WE(I),WEXE(I),WEYE(I),WEZE(I) 

IMAXP2  - IMAX  + 2 

C SUM  OF  CIINF  SHOULD  BE  1 . 0 

SUM  - 0.0 
DO  81  I - 1 , IMAX 

81  SUM  - SUM  + CIINF(I) 

IF  (SUM. EQ. 1.0)  GO  TO  85 
WRITE(* , 82)  SUM 

82  FORMAT (IX, 'SUM  OF  CIINF(I)  SHOULD  BE  1:  IT  IS  - ' .Ell. 4,'  STOP  1') 

STOP 

C STOP  1 

85  H CHECK  - HCHCKT 
TCHECK  - TCHCKT 

C READ  IN  AND  WRITE  OUT  SPECIES  AND  REACTIONS 

DO  88  I - 1 , IMAX 
88  READ(7 , 90)  SPECIE(I) 

90  FORMAT ( A3 0) 

WRITE (8 ,95) 

WRITE(*,95) 

95  FORMAT (//) 

WRITE(8 , 100) 

WRITE(* , 100) 

100  FORMAT (14X, 'SPECIES'/) 

DO  110  I - 1 , IMAX 
105  F0RMAT(1X, 15 , 11X.A30) 

WRITE(*, 105)  I , SPECIE(I) 

110  WRITE(8 , 105)  I , SPECIE(I) 

WRITE(*,95) 

WRITE(8 , 95) 

DO  112  I - 1 , JMAX 
112  READ (7 , 90)  REACT ( I ) 

WRITE(* , 115) 

WRITE (8, 115) 

115  FORMAT (14X, 'REACTIONS'/) 

DO  120  I - 1 , JMAX 
WRITE(* , 125)  I , REACT ( I ) 

120  WRITE(8 , 125)  I,REACT(I) 

125  F0RMAT(1X, 15 , 8X.A30) 

WRITE(*,95) 

WRITE(8 , 95) 

CLOSE (7) 

C PRINT  INPUT 

WRITE (8, 135)  HCHCKT, TCHCKT, PHMAX 
WRITE(* , 135)  HCHCKT , TCHCKT , PHMAX 

135  FORMAT (IX, 'HCHCKT  - ', Ell . 4 , 4X, ' TCHCKT  = ' , Ell . 4 , 4X, ' PHMAX  - ', 

Ell. 4/) 

WRITE (8, 140)  XI, CIMAX, NXPST 


H'iif 


WRITE(*, 140)  XI , CIMAX , NXPST 

140  FORMAT  (IX,  'XI  - ' ,E11.4,8X, 'CIMAX  - ' ,E11.4,5X,  'NXPST  - ',13//) 

DO  141  I - 1.IMAX21 

WRITE(*,142)  I , ELE1 ( I ) , I , ELE2 ( I ) 

141  WRITE(8 , 142)  I , ELE1(I) , I , ELE2(I) 

142  F0RMAT(1X, ' ELE1( ' , 12 , ' ) - ' , Ell .4, 5X, ' ELE2(  ' , 12 , ' ) - '.E11.4) 
WRITE(8 , 95) 

WRITE(*,95) 

DO  143  I - 1, NXPST 
WRITE(*, 144)  I ,XPST(I) 

143  WRITE(8 , 144)  I,XPST(I) 

144  F0RMAT(1X, 'XPST( ' ,13 , ' ) - '.Ell. 4) 

WRITE(8 , 95) 

WRITE(*,95) 

WRITE(8 , 145)  IMAX, JMAX.M 
WRITE(* , 145)  IMAX, JMAX.M 

145  FORMAT ( IX ,' IMAX  — ' , 12 , 11X, ' JMAX  — ',I2,13X,'M  -',12/) 

WRITE (8,150)  DELX , ZSTERM , IPF.R, PINF , TINF , VINF , GAMMA 
WRITE (* , 150 ) DELX , ZSTERM , IPF , R , PINF , TINF , VINF , GAMMA 

150  FORMAT (IX, 'DELX  - ', Ell. 4 , 2X, ' ZSTERM  - ',E11.4,2X, 

*' PRINT  FREQ.  - ',I3,3X,'R  - ', Ell. 4,//, IX, 'PINF  - ' .E11.4, 

*2X, 'TINF  — ' .E11.4.4X, 'VINF  - ' .E11.4.2X, 'GAMMA  - ’.E9.3//) 
WRITE(8 , 155) 

WRITE(*, 155) 

155  FORMAT (16X, 'MUI' ,8X, 'THETAI ' , 7X, 'DGENI ' , 10X, 'FI' , 9X, ' DELHI ’ /) 

DO  157  I - 1 , IMAX 

WRITE(* , 160)  I.MUI(I) .THETAI (I) , DGENI (I) ,FI(I) .DELHI (I) 

157  WRITE(8 , 160)  I , MUI ( I ) , THETAI  ( I ) , DGENI ( I ) , FI ( I ) , DELHI ( I ) 

160  FORMAT (IX, 12 , 8X, 5 (Ell .4 , 2X) ) 

WRITE (8 ,95) 

WRITE(8 , 161) 

WRITE(* , 95) 

WRITE(* , 161) 

161  FORMAT (16X,  'DELI'  ,8X,  'CIINF'  ,9X,  'EVI'  ,10X,  'LI'  ,11X,  'BI'/) 

DO  163  I - 1 , IMAX 

WRITE(* , 164)  I , DELI (I) , CIINF(I) , EVI (I) ,LI(I) ,BI(I) 

163  WRITE(8 , 164)  I , DELI (I) , CIINF(I) , EVI (I) , LI (I) , BI (I) 

164  FORMAT (IX, 12 , 8X, 3 (Ell . 4 , 2X) , 3X, 13 , 7X, Ell .4) 

WRITE(8 , 95) 

WRITE(8 , 165) 

WRITE(*,95) 

WRITE (*, 165) 

165  FORMAT ( 8X , 'NIP' ,9X, 'UP' ,10X,  'WE' ,10X, 'WEXE' ,9X, 'WEYE' ,8X, 'WEZE'/) 
DO  167  I - 1 , IMAX 

166  FORMAT (IX, 12 , 5X, 13 , 4X, E10 . 4 , 2X, E10 . 4 , 3X, E10 . 4 , 3X, E10 . 4 , 2X, E10 .4) 
WRITE(*, 166)  I ,NIP(I) ,UP(I) ,WE(I) ,WEXE(I) ,WEYE(I) ,WEZE(I) 

167  WRITE(8 , 166)  I ,NIP(I) ,UP(I) ,WE(I) ,WEXE(I) ,WEYE(I) ,WEZE(I) 

WRITE(8 , 95) 

WRITE(8 , 170) 

WRITE(*,95) 

WRITE(* , 170) 

170  FORMAT (12X, 'MJ' ,9X, 'AJ' ,14X,  'BJ' ,15X, 'EJ' , 10X, ' DIRECTION' ,/, 

* 69X, 'F-l.B-2 '/) 

DO  180  J - 1, JMAX, .2 

175  FORMAT (IX, 12 , 2X, 18 , 3 (2X, E15 . 6) , 5X, F5 . 2) 

WRITE(* ,175)  J , MJ(J) , AJ (J) ,BJ(J) ,EJ(J) ,DIRECT(J) 

180  WRITE(8 , 175)  J,MJ(J) ,AJ(J) ,BJ(J) ,EJ(J) , DIRECT ( J ) 

WRITE(8 , 95) 

WRITE(8 , 181) 

WRITE(*,95) 


WRITE(* , 181) 

181  FORMAT  ( 12X , ’MJ*  , 6X , * DIRECTION ' ,/,21X,  'F-l.B-2'/) 

DO  183  J - 2 , JMAX, 2 

182  FORMAT ( IX , 12 , 2X , 18 , 8X , F5 . 2 ) 

WRITE(*, 182)  J,MJ (J) ,DIRECT(J) 

183  WRITE(8 , 182)  .DIRECT (J) 

WRITE (8 , 95) 

WRITE(* , 95) 

DO  187  I - l.IMAX 
LI I - LI (I) 

DO  186  L - l.LII 

WRITE(8 , 185)  L. I ,GIL(L, I) ,L,I,EPSIIL(L,I) 

WRITE(* , 185)  L, I , GIL(L, I) ,L,I.EPSIIL(L,I) 

185  F0RMAT(1X, 'GIL(' .12. ' , ' ,12. ’)  - '.E11.4.4X, 

* 'EPSIIL(' ,12, ' , ' ,12, ')  - ' , Ell .4) 

186  CONTINUE 

187  CONTINUE 
WRITE(8 , 95) 

WRITE(* , 95) 

DO  200  I - l.IMAX 
DO  196  J - 1 , JMAX 
WRITE(*, 195)  I , J , AIJ(I , J) 

WRITE(8 , 195)  I , J ,AIJ (I , J) 

195  F0RMAT(1X, 'AIJ(' ,12, ' , ' ,12, ')  - ' .E11.4) 

196  CONTINUE 

200  CONTINUE 
WRITE(8 , 95) 

WRITE(* , 95) 

DO  205  I - 1 , IMAX+1 
DO  202  J - 1 , JMAX 

WRITE(8 , 201)  I , J ,NUIJ (I , J) , I , J ,NUPIJ (I , J) 

WRITE(* , 201)  I , J , NUI J ( I , J ) , I , J , NUPIJ ( I , J ) 

201  F0RMAT(1X, 'NUIJ(' ,12, ' , ' ,12, ')  - ' , 15 , 9X,  'NUPIJ( ' , 12 , ' , ' , 

* 12,')  - ' ,15) 

202  CONTINUE 
205  CONTINUE 

WRITE(8 , 95) 

WRITE(*,95) 

DO  225  I - l.IMAX 
DO  220  J - l.IMAX 

WRITE(8 , 210)  I , J , SIGIK(I , J) , I , J , ALPIK(I , J) , I , J , BETAIK(I , J) 

WRITE(*,210)  I , J , SIGIK(I , J)  , I , J , ALPIK(I , J)  , I , J , BETAIK(I , J) 

210  F0RMAT(1X, 'SIG1K(' ,12, ' , ' ,12, ' ) - '.E10.4.1X, 

*'ALPIK(',I2,',',I2,')  - ' ,E10.4,1X, 'BETAIK(' , 12 , ' , ' , 12 , ' ) - ', 

*E10 .4) 

220  CONTINUE 
225  CONTINUE 

WRITE(8 , 95) 

WRITE(8 , 230) 

WRITE(*,95) 

WRITE(* , 230) 

230  FORMAT (7X , 25 ('*'), ' END  INPUT  ' , 25 ( '*' )///) 

WRITE(8 , 231) 

WRITE(* , 231) 

231  FORMAT ( 2 5X, '-H-+  SHOCK  GEOMETRY  +++'//) 

NXPSTM1  - NXPST  - 1 

DEFINE  SHOCK  GEOMETRY 

CALL  SHOCKG  (NXPSTM1 , ITK) 

IZTERM  - NO.  OF  DELTA  X INCREMENTS  GENERATED  IN  SHOCKG 
IF  (IQ4.GT.0. AND. IZTERM. GT. 30)  THEN 


WRITE(*, 232)  IZTERM 

232  FORMAT (IX, 'IZTERM  - ' , 14 , 2X, 'WITH  A RADIATION  MODEL  SELECTED* 

* ,/, IX. 'MAXIMUM  NO.  OF  STREAMLINES  .LE.  30') 

STOP 

ENDIF 

WRITE(8 , 95) 

WRITE(* , 95) 

IF  ( (NXPST  - 1.0) .LE. IZTERM)  GO  TO  237 
WRITE(*, 235) 

235  F0RMAT(1X, ’ (NXPST-1) .GT. IZTERM  : IT  MUST  BE  .LE.  TO  IZTERM',/, 

* IX, 'PHYSICAL  SPACE  CALCULATIONS  - SEE  DO  700  LOOP  : STOP  301'/) 
STOP 

237  WRITE(8 , 95) 

WRITE(*,95) 

IF  (IZTERM. LE. 200)  GO  TO  241 
WRITE(*, 240) 

240  F0RMAT(1X, 'IZTERM. GT.200:CHGE  DIM  OF  P.DPDX  AND  VARI : STOP  301'/) 

STOP 

C FREESTREAM  QUANITIES 

241  SUM  - 0.0 

DO  245  I - l.IMAX 
245  SUM  - SUM  + CIINF(I)/MUI (I) 

MUINF  - 1.0/SUM 

RHOINF  - MUINF*PINF/(R*TINF) 

AINF  - DSQRT(GAMMA*R*TINF/MUINF) 

MINF  - VINF/AINF 

C FOR  EACH  I , SPECIE 

EINF  - 0.0 
DO  275  I - l.IMAX 
TEM  - DEXP(THETAI (I )/TINF) 

EVIINF(I)  - (R*THETAI(I) )/(MUI(I)*(TEM  - 1.0))*FI(I) 

C FOR  EACH  L,  REACTION  LEVEL 

GSUM  - 0.0 
GESUM  - 0.0 
LI I - LI (I) 

IF  (LII.LE.20)  GO  TO  255 
WRITE(*,250)  LI I 

250  FORMAT (IX, 'LI I -\I3,2X,'A  LEVEL  IN  LI  ARRAY  IS  GREATER  THAN  20', 

* 2X , / , IX , ' YOU  NEED  TO  CHANGE  DIMENSION  OF  EPSIIL  AND  GIL') 

255  CONTINUE 

DO  265  L - l.LII 

TEM1  - DEXP(-EPSIIL(L, I)/TINF) 

GSUM  - GSUM  + GIL(L, I)*TEM1 
GESUM  - GESUM  + GIL(L, I)*EPSIIL(L, I)*TEM1 
265  CONTINUE 

EEIINF  - R/MUI (I)*(GESUM/GSUM) 

EIINF  - 1 . 5*R*TINF/MUI ( I ) + FI(I)*R*TINF/MUI(I)  + EVIINF(I) 

* + EEIINF  + DELHI ( I ) /MUI ( I ) 

EINF  - EINF  + EIINF*CIINF(I) 

275  CONTINUE 

WRITE (8,280)  MUINF , RHOINF , AINF , TINF , PINF , VINF , MINF , EIINF , EINF , 

* EEIINF 

WRITE (* , 280 ) MUINF , RHOINF , AINF , TINF , PINF , VINF , MINF , EIINF , EINF , 

* EEIINF 

280  FORMAT ( 24X, '+++  FREESTREAM  QUANTITIES  +++',///, 6X, 'MUINF  - '.E11.4 
*,3X, 'RHOINF  - 'E11.4.3X, 'AINF  - ' , Ell .4 ,//, 6X, 'TINF  - '.E11.4.3X, 

*' PINF  - ' ,E11.4,3X, 'VINF  - ', Ell. 4,//, IX, 'MINF  - '.E10.4.2X, 

*' EIINF  - ' .E10.4.2X, 'EINF  - ', E10 .4 , 2X, ' EEIINF  - '.E10.4//) 

DO  285  I - l.IMAX 
WRITE (* ,286)  I , EVIINF(I) 


285  WRITE(8 , 286)  I.EVIINF(I) 

286  F0RMAT(1X, ' EVIINF( ' , 12 , ' ) - '.E11.4) 

WRITE (8 , 95) 

WRITE(* , 95) 

C BEGIN  QUANTITIES  BEHIND  SHOCK  FOR  THE  RANGE  OF  X 

WRITE(8 , 290) 

WRITE(* , 290) 

290  FORMAT ( 2 2X , '+++  QUANTITIES  BEHIND  SHOCK  +++',///, 5X, ' TS ', 9X, ' ES ' , 

*9X, 'PS' , 7X, 'RHOS' , 8X, 'US' ,8X, 'PSIS' ,8X, 'HS'/) 

IF  (NXPST.GE. 3)  GO  TO  293 
WRITE(* , 291) 

STOP 

291  FORMAT ( IX , 'NXPST  - 2 - SURELY  SOME  PHYSICAL  SPACE  VALUES ',/, IX, 

* 'ARE  DESIRED  --  MAKE  IT  AT  LEAST  3 : STOP  2') 

293  OPEN  (UNIT-9,  FILE-OUTFL2  , STATUS- 'UNKNOWN') 

OPEN  (UNIT-10 .FILE- 'STAG. DAT'  , STATUS- 'UNKNOWN ' ) 

OPEN  (UNIT-11,  FILE- 'EVISC.DAT'  , STATUS- 'UNKNOWN ' ) 

C 

DO  385  IX  - 1 , IZTERM 

TEM  - SINTM(IX)**2 

LAMBDA  - RHOINF*VINF*S INTM (IX) 

OMEGA  - PINF  + RHOINF*VINF**2*TEM 

DELTA  - EINF  + PINF/RHOINF  + (VINF**2*TEM)/2 . 0 

LAMSQ  - LAMBDA** 2 

OMEGSQ  - OMEGA** 2 

MINFSQ  - MINF**2 

TEM  - TEM*MINFSQ 

TSG  - (TINF*(2 . 0*GAMMA*TEM  - (GAMMA  - 1 . 0)  )*(  (GAMMA  - 1.0) 

* *TEM  + 2 . 0 ) ) / ( ( GAMMA  + 1.0)**2*TEM) 

TOL1  - .001 

TOL2  - .0001 

MAXI  - 50  o 

C 

IF  (IQ3.EQ.1)  CALL  FOFTS1  (MAXI , T0L1 , TOL2 , ICODE , TSG) 

IF  (IQ3.GT.1)  CALL  FOFTS23  (MAXI ,T0L1 ,TOL2 , ICODE, TSG , IQ1 , IQ2 , IQ3) 

C 

IF  (ICODE. EQ.l)  WRITE(*, 330)  TSG 

330  FORMAT ( IX, '****  MAXIMUM  ITERATION  EXCEEDED  IN  FOFTS  ****',//, 

* IX, 'LAST  ITERATED  VALUE  OF  TSG  WAS  '.E15.6,'  : STOP  321'/) 

IF  (ICODE. EQ. 2)  WRITE(*,335) 

335  FORMAT (IX, '*****  DERIVATIVE  - 0.0  IN  FOFTS  *****  : STOP  321'/) 

IF  (ICODE. EQ.l. OR. ICODE. EQ. 2)  STOP 

C STOP  321 

IF  (IX. EQ.l)  WRITE(15 ,*)  TSG 
TS  - TSG 
ES  - 0.0 

DO  360  I - 1 , IMAX 

IF  (M.EQ.l)  EVIS(I)  - EVIINF(I) 

IF  (M.EQ.l)  GO  TO  345 
TEM  - DEXP ( THETAI ( I ) /TS ) 

EVIS(I)  - (R*THETAI (I) )/(MUI (I)*(TEM  - 1.0))*FI(I) 

345  SUMG  - 0.0 
SUMGE  - 0.0 
LI I - LI (I) 

DO  350  L - l.LII 

TEM1  - DEXP( -EPSIIL(L, I)/TS) 

SUMG  - SUMG  + TEM1*GIL(L, I) 

350  SUMGE  - SUMGE  + TEM1*GIL(L, I)*EPSIIL(L, I) 

EEIS  - (R/MUI (I) )*(SUMGE/SUMG) 

EIS  - ( 1 . 5*R*TS ) /MUI ( I ) + ( FI ( I ) *R*TS ) /MUI ( I ) + EVIS(I) 


4*4*1 


* + EEIS  + DELHI ( I ) /MUI ( I ) 

IF  (IQ3.EQ.1)  THEN 
ES  - ES  + EIS*CIINF(I) 

ELSE 

ES  - ES  + EIS*CID(IX, I) 

ENDIF 

360  CONTINUE 

PS  - DSQRT(OMEGSQ  - 2 . 0*LAMSQ* ( DELTA  - ES)) 

RHOS  - (MUINF*PS)/(R*TS) 

US  - VINF*COSTM(IX) 

PSIS  - (RHOINF*VINF*RSM(IX)**2)/2 . 0 
HS  - PS/RHOS  + ES 

WRITE (10 , *)  IX , TS , ES , PS , RHOS , US , PSIS , HS 
WRITE(8 , 365)  TS , ES , PS ,RHOS ,US , PSIS ,HS 
WRITE (* , 365)  TS , ES , PS , RHOS , US , PSIS ,HS 

365  FORMAT ( IX , 7 ( E9 . 4 , 2X) ) 

WRITE(9 , 366)  IX 

366  FORMAT (IX, 'FOR  IZTERM  - ’,13//) 

DO  370  I - l.IMAX 

WRITE(9 , 367)  I.EVIS(I) 

367  F0RMAT(13X, ' EVIS(  ' , 12 , ' ) - \E11.4) 

370  CONTINUE 

WRITE(11,*)  (EVIS(I) , I - l.IMAX) 

WRITE(9 , 620) 

385  CONTINUE 
C 

CL0SE(9) 

CLOSE (10) 

CLOSE (11) 

OPEN  (UNIT-10 , FILE- ' STAG . DAT ' , STATUS- ' OLD ' ) 

OPEN  (UNIT-11 .FILE- 'EVISC.DAT' , STATUS-' OLD ' ) 

C COMPUTE  PRESSURE  DISTRIBUTION  FOR  EACH  PSI 

OPEN  (UNIT-12  , FILE- ' PRESS  . DAT ' , STATUS- ' UNKNOWN ' ) 

DO  390  IPSI  - 1, IZTERM 
DO  388  IX  - 1, IZTERM 
IF  (IX. EQ. IPSI)  XX  - Xl(IX) 

READ(10,*)  IXT, TS.ES.PS, RHOS, US, PSIS, HS 
IF  (IXT. LT. IPSI)  GO  TO  388 
IF  (IXT. EQ. IPSI)  PSISHK  - PSIS 
IF  (IPSI . EQ. IX)  THEN 
P(IX)  - PS 
GO  TO  388 
ENDIF 

P(IX)  - PS  + US/ (RCM(IX)*RSM(IX) )*(PSISHK  - PSIS) 

388  CONTINUE 
CLOSE(IO) 

OPEN  (UNIT-10 , FILE- ' STAG . DAT ' , STATUS- ' OLD ' ) 

WRITE(12 ,*)  XX,(P(IX),IX  - 1, IZTERM), IPSI, IZTERM 
390  CONTINUE 
CLOSE (12) 

OPEN  (UNIT-12,  FILE- 'PRESS. DAT' , STATUS-' OLD' ) 

OPEN  (UNIT-13, FILE- 'DPDX.DAT'  , STATUS- 'UNKNOWN ' ) 

C COMPUTE  DPDX  AND  VARI 

DO  404  IPSI  - 1, IZTERM 

READ(12 ,*)  X, (P( I) ,1-1, IZTERM) ,IPI, IZTERM 
I THIS  - 0 

DO  401  IX  = IPSI, IZTERM 
IF  (IX. EQ. IPSI)  XT  - X 

IF  (IX.GT.IPSI.AND.IPSI.LT. (NSR+2))  XT  - XT  + DELX/NSR 
IF  (IX. GT. IPSI. AND. IPSI. GT. (NSR+1))  XT  - XT  + DELX 


I THIS  - I THIS  + 1 
VARI(ITHIS)  - XT 

401  CONTINUE 

DO  403  IX  - IPSI , IZTERM 

C DIFFERENTIATE 

IF  (IX. NE. IPSI)  GO  TO  402 

DPDX(IX)  - (-  3.*P(IX)  + 4.*P(IX+1)  - P ( IX+2 ) ) / ( 2 . 0*DELX) 

GO  TO  403 

402  DPDX(IX)  - (-  P(IX-l)  + P ( IX+1 ) ) / ( 2 . 0*DELX) 

IF  ( IX. NE. IZTERM)  GO  TO  403 

DPDX(IX)  - (P(IX-2)  - 4.*P(IX-1)  + 3 . *P ( IX) ) /( 2 . 0*DELX) 

403  CONTINUE 

WRITE ( 13 ,*)  (DPDX(I) , 1-1 , IZTERM) , IPSI , IZTERM 

404  CONTINUE 
CLOSE(13) 

CLOSE(12) 

OPEN  (UNIT-12 , FILE- ' PRESS  . DAT ' , STATUS- ' OLD ' ) 

OPEN  (UNIT-13 , FILE- ' DPDX . DAT ' , STATUS- ' OLD ' ) 

C 

DO  405  IX  - 1, IZTERM 
IF  (IX.EQ.l)  VARI(l)  - 0.0 
IF  (IX.EQ.l)  GO  TO  405 

IF  (IX.LT. (NSR+2) ) VARI(IX)  - VARI(IX-l)  + DELX/NSR 
IF  (IX.GT. (NSR+1) ) VARI(IX)  - VARI(IX-l)  + DELX 

405  CONTINUE 
WRITE(8 , 95) 

WRITE(*,95) 

WRITE(8 ,407)  ITK.NXPST 
WRITE(*,407)  ITK.NXPST 

407  FORMAT  ( IX, 'XXXXX  ITK  - ’,13 , 5X, 'NXPST  - ',13 , ' XXXXX’//) 

IF  (ITK.GE. (2*NXPST/4))  GO  TO  409 

WRITE (*.408) 

408  FORMAT  (IX, 'NO.  OF  X-S  IN  XPST  ARRAY,  ITK,  IS  .LT.  .5*NXPST',/ 

* , IX, 'REEXAMINE  DELX, NXPST  AND  XPST  ARRAY  : STOP  301'/) 

STOP 

C STOP  301 

C 

C END  COMPUTATION  OF  QUANTITIES  BEHIND  SHOCK  ; INTEGRATE  ALONG  EACH  PSI 
C 

C VAR(l)  - XV AR 

C VAR(2)  - H, ENTHALPY  VAR(2)  MUST  BE  H,  WHICH  MAY  BE  + OR  - 

C 

C CONCENTRATION  OF  SPECIE 

C VAR(3)  - CI(1) 

C VAR(2+IMAX)  - CI(IMAX) 

C EQUILIBRIUM  VIBRATIONAL  ENERGY 

C VAR ( 2+IMAX+l ) - EVI(l) 

C VAR(2+IMAX+IMAX)  - EVI(IMAX) 

C 

409  WRITE (8 ,411) 

WRITE (*,411) 

411  FORMAT (IX, 'NO.  OF  VIB.  LEVELS  TO  DISSOCIATION',/) 

DO  410  I - l.IMAX 

C TRUNCATE 

YIY  - FI ( I ) *(DELI ( I ) /THETAI ( I ) +1.0) 

NI (I)  - AINT (YIY) 

WRITE(* , 412)  I ,NI(I) 

410  WRITE(8 ,412)  I,NI(I) 

412  F0RMAT(11X, 'NI(' ,12, ')  - ',13) 

WRITE(* , 95) 


WRITE(8 , 95) 

MU  - 0.0 

N - 1 + 2*IMAX 

IF  (M.EQ.O)  N - N - IMAX 

C INITIALIZE 

WRITE(8 , 415)  IZTERM 
WRITE(*,415)  IZTERM 
415  F0RMAT(1X, 'IZTERM  -' ,14///) 

WRITE(8 ,417) 

WRITE(*,417) 

417  FORMAT (IX, 'COUPLED  VIBRATION-DISSOCIATION  MODELS' ,//,12X, 

* 'TYPE' ,11X, 'NO. ' ,//,9X, 'VIB.  EQUIL. ' ,8X,  '0' ,/ ,12X, 'CVD' ,13X, 

* '1' ,/,12X, 'CVDV' ,12X, '2' ,/,6X, 'CVDV- Preferential ' ,5X,  '3'  ,/, 

* 12X, 'PARK' ,12X, '4'///) 

WRITE(8,418) 

WRITE(*,418) 

418  FORMAT (7X, 'SHOCK  JUMP  CONDITION  MODELS ’,//, 12X, 

* 'TYPE' ,11X, 'NO. ' ,//,6X, 'CHEMISTRY  FROZEN' , 6X, ' 1 ',/, 5X, 

*'N2  FROZEN,  02  DISS . ' , 4X, ' 2 ' ,/ , 7X, 'N2  AND  02  DISS . ' , 6X, ' 3 '//) 

IF  (MW. EQ. 1)  THEN 
WRITE(*,419) 

WRITE(8 ,419) 

419  FORMAT (3X, 'MILLIKAN  AND  WHITE  DATA  FOR  N2  WAS  SELECTED'/) 

ENDIF 

KSTAG  - 0 
ISTAG  - 0 
XPST(l)  - DELX 

XPST(NXPST)  - VARI (IZTERM)  + 100.0 

SUMCI  - 0.0 

WRITE(*,95) 

WRITE(8 , 95) 

LPS1  - 1 
IPSI  - 0 

OPEN  (UNIT-14 , FILE- ' RHORT . DAT ' , STATUS- ' UNKNOWN ' ) 

OPEN  (UNIT-16, FILE- 'RADIN2.DAT' , STATUS- 'UNKNOWN ' ) 

C BEGIN  EACH  STREAMLINE  COMPUTATION  HERE 

420  IPSI  - IPSI  + 1 

IF  (IPSI. EQ. IZTERM)  GO  TO  735 
425  KIPF  - 0 

C ISTAG  - 2 FOR  STREAMLINE  DELX 

IF  (ISTAG. EQ.l)  ISTAG  - 2 
READ(10,*)  IX, TS , ES , PS ,RHOS ,US , PSIS ,HS 
READ(11 ,*)  (EVIS(I) ,1  - 1 , IMAX) 

IF  (IPSI. EQ.l)  HSTAG  - HS 
CJ  - XI 
SPEC  - 0.0 

C EVALUATE  DERIVATIVES  WHEN  SPEC  - 0.0 

II  - 0 

C USE  SHOCK  VALUES  FOR  INITIAL  COMPUTATION  ON  EACH  STREAMLINE 

KEYINT  - 0 
IX  - 0 
T - TS 

IF  (M.EQ.O)  GO  TO  450 
DO  445  I - 1 , IMAX 
445  TVI(I)  — TINF 
GO  TO  460 

450  DO  455  I - l.IMAX 
455  TVI(I)  - TS 
460  RHO  - RHOS 

IF  (IQ3.GT.1)  THEN 
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SUM  - 0.0 

DO  462  I - l.IMAX 

462  SUM  - SUM  + CID(IPSI , I)/MUI(I) 

MU  - 1.0/SUM 
ENDIF 

IF  (IQ3.EQ.1)  MU  - MUINF 
U - US 

DO  465  I - 1 , IMAX 
MM  - 2 + I 
K - IMAX  + MM 
VAR(MM)  - 0.0 

IF  (IQ3.EQ.1)  VAR(MM)  - CIINF(I) 

IF  (IQ3.GT.1)  VAR(MM)  - CID(IPSI.I) 

VAR(K)  - 0.0 

IF  (M.EQ.O)  VAR(K)  - EVIS(I) 

IF  (M.EQ.l)  VAR(K)  - EVIINF(I) 

EVI(I)  - VAR(K) 

465  CONTINUE 

C COMPUTE  S EXPONENT  FOR  PARK  MODEL 

IF  (MODEL. EQ. 4)  THEN 
SP  - 3 . 5*DEXP ( - 5000 . 0/TS ) 

ENDIF 
E - ES 
H - HS 

IF  ((IPSI.EQ. (NSR+1)) .AND. (ISTAG.EQ.O))  GO  TO  635 
READ(12,*)  X, (P(L) , L-l , IZTERM) , IPSI , IZTERM 
READ(13 , *)  (DPDX(L) , L-l , IZTERM) , IPSI , IZTERM 
VAR(l)  - X 

C OMIT  PSI  - 0.0  STREAMLINE  FOR  NOW  - PICK  IT  UP  LATER 

IF  (X.NE.0.0)  GO  TO  490 
IG  - 0 

WRITE(*, 725) 

WRITE (8, 725) 

GO  TO  730 

490  IF  (IANS.EQ.l)  THEN 

IF  ((IPSI. EQ.IS1) .OR. (IPSI.EQ. IS2) .OR. (IPSI.EQ. IS3))  GO  TO  492 
IF  ((IPSI. EQ.IS4) .OR. (IPSI.EQ. IS5) .OR. (IPSI.EQ. IS6))  GO  TO  492 
GO  TO  730 
ENDIF 

492  IF  (DABS (X  - VARI (IPSI) ). LE. 1 . 0E-06)  GO  TO  500 
WRITE(*,495)  IPSI ,X,VARI(IPSI) 

495  F0RMAT(1X, 'IPSI  - \I3,2X,'X  = ' , E10 . 5 , 2X, ' VARI (IPSI)  - '.E10.5, 

*//.lX,'X  AND  VARI ( IPSI ) SHOULD  BE  EQUAL  : EXAMINE  GENERATION  OF  X 
* AND  VARI  IN  MAIN  : STOP  663'/) 

STOP 

STOP  663 

INITIALIZE 

500  IF  (IANS.EQ.l)  THEN 

IF  ((IPSI. EQ.IS1). OR. (IPSI.EQ. IS2). OR. (IPSI.EQ. IS3))  GO  TO  501 
IF  ((IPSI. EQ.IS4). OR. (IPSI.EQ. IS5) .OR. (IPSI.EQ. IS6))  GO  TO  501 
GO  TO  730 
ENDIF 

501  ELB  - 0.0 
SPEC  - 0.0 

IF  (VAR(l) .GT.XPST(LPSl) ) LPS1  - LPS1  + 1 
LPS2  - LPS1 
505  IX  = IX  + 1 

CALINTH  - MODIFIED  RUNGE-KUTTA 

CALL  CALINTH  (N , CIMAX, PHMAX) 


IF  (NERR.EQ.O)  GO  TO  575 
IF  (NERR.EQ.l)  WRITE(*,565)  CJ,N 

565  FORMAT (IX, 'BAD  INPUT  IN  CALINTH' ,/,  IX, 'CJ  - ' , ElO.  5 , 2X,  'N  - ',14 
* , / , IX , ' STOP  665'/) 

IF  (NERR.EQ.2)  WRITE(*,570) 

570  FORMAT (IX,  'EXAMINE  ELE1  AND  ELE2  IN  CALINTH  : STOP  665'/) 

IF  ((NERR.EQ.l). OR. (NERR.EQ.2))  STOP 

STOP  665 


575  IF  (IX.EQ.l)  THEN 
IF  (IQ3.NE.1)  THEN 
IF  (IQ2.EQ.1)  TE  - TINF 
IF  (IQ2.EQ.2)  TE  - TS 
TE1  - TE 
TE2  - TE 
ELSE 

TE  - TINF 
TE1  - TE 
TE2  - TE 
ENDIF 
ENDIF 

ELECTRON  TEMPERATURE  MODEL 

IF  (IX.EQ.l)  GO  TO  576 
CORR  - 4 . 23E-06*(T**(-2 . 88) ) 

CN  — RH0*6 . 02252E+23 
CNN  - CN*VAR( 5 ) /MUI ( 3 ) 

CNO  - CN*VAR(6)/MUI (4) 

TE  - DLOG ( 1 . + 10 . l/( (CNO+CNN)*CORR) ) 

TE  - T/(l.  + TE*T/85000 . ) 

TE1  - TE 

CN2  - RHO*6 . 02252E+23*VAR(3)/MUI (1) 

A - DLOG(1.01D+01)  - DLOG(CN2)  - DL0G(6 .4D+00) 

* - 5 9 . *DLOG ( 1 . OD+0 1 ) + 19 . *DLOG(TVI(l) ) 

A - DEXP(A) 

TE  - DLOG ( 1 . + A) 

TE  - TVI (1) /(I . + TE*TVI(l)/85000. ) 

TE2  - TE 


576  IF  (IX.EQ.l)  GO  TO  580 

IF  ((IPSI.EQ. (NSR+1)) .AND. (IX. EQ. (NSR+1)))  GO  TO  580 
IF  (VAR(l) .GE.VARI(IZTERM) ) GO  TO  580 
IF  ((IPSI.LT. (NSR+1)). AND. (VAR(l) .GE.DELX))  GO  TO  580 
KIPF  - KIPF  + 1 
IF  (KIPF.NE. IPF)  GO  TO  625 
KIPF  - 0 
580  SUMCI  - 0.0 

DO  590  I SUM  - 3 , IMAXP2 
IF  (VAR(ISUM) .LT.0.0)  NEG  - -1 
IF  (VAR(ISUM). LT.0.0)  WRITE(*,585) 

585  FORMAT (5X,  ' NEGATIVE  Cl '/) 

590  SUMCI  - SUMCI  + VAR(ISUM) 

DO  595  I CM  - l.IMAX 
595  CM(ICM)  - VAR ( ICM+2 ) *MU/MUI ( I CM) 

PRINT  ANSWERS 

WRITE (8,600)  IPSI , IX , IQ3 , MODEL , XVAR , H , MU , PFTL , RHO , U , T , E , SPEC , SUMCI 
WRITE (* , 600 ) I PSI , IX , IQ3 , MODEL , XVAR , H , MU , PFTL , RHO , U , T , E , SPEC , SUMCI 
600  FORMAT (IX, 'PSI  - ',I4,3X,'IX  = ', 14 , 8X, ' SHOCK  J COND.  - ' ,I2,14X, 

*' CVD  MODEL  - ' ,12,/  , IX, 'X  - ' ,D9.4,2X, 'H  - ' ,D9.4,2X, 'MU  — ' , 

*E9 . 4 , 2X, ' P - ' ,E9.4,3X, 'RHO  - ',E9.4,/  ,1X,'U  = ',E9.4,2X,'T  - 
*E9.4,2X, 'E  - ' ,E9.4,2X, 'CIT  - ' , E9 . 4 , 2X, ' SUMCI  - '.E9.4  ) 

DO  603  I = 3.IMAXP2 


o o o 


J - I - 2 

WRITE(* , 605)  J ,VAR(I) , J , CM(J) , J ,VAR(IMAX+I) 

603  WRITE (8 ,605)  J ,VAR(I) , J , CM(J) , J ,VAR(IMAX+I) 

605  FORMAT ( 6X, 'Cl (' ,12,')  - ' .D11.4.4X, 'CM(' ,12, ')  - \E11.4,4X, 

* ' EVI ( ' ,12,')  - ' , D11.4) 

C WRITE(*, 620) 

WRITE(8 , 620) 

620  FORMAT (/) 

DO  621  I - l.IMAX 
IF  (EVI(I) .EQ.0.0)  TVI(I)  - 0.0 
IF  (I.EQ.IMAX)  THEN 
WRITE(*, 623)  I , TVI ( I ) , TE1 , TE2 
WRITE(8 , 623)  I,TVI(I) ,TE1, TE2 
GO  TO  621 
ENDIF 

WRITE(*, 622)  I ,TVI(I) 

WRITE(8 , 622)  I,TVI(I) 

621  CONTINUE 

622  FORMAT ( 5X , ' TVI ( ' , 12 , ' ) - '.E11.4) 

623  FORMAT ( 5X , ' TVI ( ' , 12 , ' ) - ' ,E11.4,4X, 'TE1  - '.E11.4.4X, 

* 'TE2  - '.Ell. 4) 

C WRITE(* , 620) 

WRITE(8 , 620) 

625  IF  (NEG.EQ.-l)  WRITE(*,630) 

630  FORMAT ( IX , ' A NEGATIVE  CONCENTRATION  , Cl  IN  MAIN  : STOP  670'/) 

IF  (NEG.EQ.-l)  STOP 

C STOP  670 

C WHEN  IPSI  - (NSR+1),  DELX  AND  STAGNATION  STREAMLINES  WILL  BE  COMPUTED 
C IUNEG  - 1 IF  U**2  NEG.  IN  BASIC 


C 

C 


IF  (IUNEG. EQ.l)  GO  TO  735 

IF  ( (IPSI. LT. (NSR+1)) .AND. (VAR(l) .LT.XPST(l) ) ) GO  TO  505 
IF  ( (ISTAG. EQ. 1) .OR. (ISTAG . EQ. 2) ) GO  TO  690 

ISTAG  - 0 UNTIL  AFTER  EXTRAPOLATION  FOR  PSI  - 0.0  STREAMLINE 

ISTAG  - 1 FOR  PSI  - 0.0  STREAMLINE 

ISTAG  - 2 FOR  DELX  STREAMLINE  AND  THEREAFTER 

635  IG  - IG+1 
IGC  - 0 

IGE  - IMAX  + 2 
PSIG(IG)  - PSIS 
DO  640  IG1  - 3 , IMAXP2 
IGC  - IGC  + 1 
CIG(IGC.IG)  - VAR(IGl) 

IGE  - IGE  + 1 
EIG(IGC.IG)  - VAR (IGE) 

640  CONTINUE 
EG(IG)  - E 
TG(IG)  - T 
HG(IG)  - H 

IF  (IPSI. LT. (NSR+1))  WRITE(8 , 725) 

IF  (IPSI. LT. (NSR+1))  WRITE(*, 725) 

IF  (IPSI. LT. (NSR+1))  GO  TO  730 

IPSI  - (NSR+1)  IS  THE  STAGNATION  STREAMLINE  ; 
AT  DELX  .EXTRAPOLATE  FOR  PSI  - 0.0  VALUES 

PSI  - 0.0 
MG  - 1 

CALL  FTLUP  (PSI , E ,MG , IG , PSIG , EG) 

CALL  FTLUP  (PSI ,T,MG , IG , PSIG ,TG) 

CALL  FTLUP  (PSI ,H,MG , IG , PSIG , HG) 

DO  650  IG2  - 1 , IMAX 
DO  645  IG1  - 1.NSR1 


CIT(IGl)  - CIG(IG2,IG1) 

645  EIT(IGl)  - EIG(IG2,IG1) 

CALL  FTLUP  (PSI , CI(IG2) ,MG , IG, PSIG , CIT) 

IF  (CI(IG2) .LT.O.O)  Cl (IG2)  - 1.0E-08 
CALL  FTLUP  (PSI, EVI(IG2) ,MG,IG, PSIG, EIT) 

650  VAR ( 2+IMAX+IG 2 ) - EVI(IG2) 

C INITIALIZE  FOR  PSI  - 0.0  STREAMLINE 

CJ  - XI 
SPEC  - 0.0 
II  - 0 
KEYINT  - 0 
IX  - 0 
SUM  - 0.0 
DO  660  I - l.IMAX 
SUM  - SUM  + CI(I)/MUI(I) 

IF  (EVI(I).EQ.O.O)  TVI(I)  - 0.0 
IF  (EVI(I) .EQ.O.O)  GO  TO  660 

XL  - ( (DGENI (I)*R*THETAI (I) )/(MUI (I)*EVI(I) ) + 1.0) 

ALN  - DLOG(XL) 

TVI(I)  - THETAI ( I ) /ALN 
660  CONTINUE 

MU  - 1.0/SUM 

U - DSQRT(2 . 0*(HSTAG  - H) ) 

VAR(l)  - DELX 

C COMPUTE  P AND  DPDX  AT  IPSI  - (NSR+1)  ( AT  THE  BODY  ) 

IF  (IANS.EQ.O)  WRITE(8 , 665) 

IF  ((IPSI.EQ.IS1) .OR. (IPSI.EQ.IS2) .OR. (IPSI . EQ. IS3) ) WRITE(8,665) 

IF  ( (IPSI . EQ. IS4) . OR. (IPSI.EQ.IS5) .OR. (IPSI . EQ . IS6) ) WRITE(8,665) 

IF  (IANS.EQ.O)  WRITE (* , 665) 

IF  ((IPSI.EQ.IS1) .OR. (IPSI.EQ.IS2) .OR. (IPSI .EQ. IS3) ) WRITE(*,665) 

IF  ((IPSI.EQ.IS4) .OR. (IPSI.EQ.IS5) .OR. (IPSI . EQ. IS6) ) WRITE(*,665) 

665  F0RMAT(1X, ' - * PSI  - 0.000  STREAMLINE 

P (NSR+1)  - PS  + US/ (RCM(NSR+1)*RSM(NSR+1) )*( -PSIS) 

RHO  - P(NSR+1)/(H  - E) 

NSR2  - NSR  + 2 
DO  670  I - NSR2 , IZTERM 
READ(10,*)  IXT.TS , ES , PS ,RHOS ,US , PSIS ,HS 
670  P(I)  - PS  + US/(RCM(I)*RSM(I))*(-  PSIS) 

CLOSE (10) 

CLOSE(ll) 

DPDX(NSR+1)  - ( - 3 . *P(NSRl)+4 . *P(NSR2) -P(NSR+3) )/(2 . *DELX) 

C EVALUATE  DPDX  FROM  (NSR+2)  TO  IZTERM 

DO  680  I - NSR2, IZTERM 
IF  ( I. LT. IZTERM)  THEN 
DPDX(I)  - (-  P(I-l)  + P ( 1+1 ) ) / ( 2 . *DELX) 

ELSE 

DPDX ( I ) - (P(I-2)  - 4.*P(I-1)  + 3.*P(I))/(2. *DELX) 

ENDIF 

680  CONTINUE 

OPEN  (UNIT-10, FILE- 'STAG. DAT' .STATUS- 'OLD') 

OPEN  (UNIT-11, FILE-' EVISC.DAT' , STATUS-’ OLD' ) 

DO  685  I - l.NSR 

READ (10 , *)  IX,TS , ES , PS , RHOS ,US , PSIS ,HS 
685  READ(11,*)  (EVIS(J),J  - l.IMAX) 

I STAG  - 1 
PSIS  - 0.0 
GO  TO  500 

AT  EACH  X WHERE  PHYSICAL  SPACE  CALCULATIONS  ARE  DESIRED  SAVE 

l./(RHO*U)  ON  EACH  STREAMLINE 

690  IF  (XPST(LPS2) .EQ.XPST(l))  ICNT  - IPSI 


JJJ  - IPSI  - ICNT  + 1 

IF  (VAR(l) .LT.XPST(LPS2) ) GO  TO  720 

IF  (VAR(l) . GT.XPST(LPS2))  GO  TO  705 

VAR(l)  - XPST(LPS2) 

RHOURT  - 1.0/(RHO*U) 

TEMP  - TVI(l) 

TEMPO  - T 
RCON1  - VAR(3) 

RCON2  - VAR (4) 

RCON3  - VAR(5) 

RC0N4  - VAR(6) 

RCON5  - VAR(7) 

RCON6  - VAR(8) 

RCON7  - VAR(9) 

IF  (IMAX. EQ. 10)  THEN 
RCON8  - VAR (10) 

RCON9  - VAR(ll) 

RCONIO  - VAR (12) 

END  IF 

RRHO  - RHO 

WRITE(14 ,*)  IPSI, RHOURT, VAR(l) ,PSIS 
WRITE(16 ,*)  LPS2.JJJ 

IF  (IMAX.EQ.7)  WRITE (16,*)  RCON1 , RCON2 , RCON3 , RC0N4 , RCON5 , 

* RCON6.RCON7, RRHO, TEMP, TEMPO 

IF  (IMAX. EQ. 10)  WRITE(16 , *)  RCON1 ,RCON2 .RCON3 , RC0N4 ,RCON5 .RCON6 

* , RCON7 , RCON8 , RCON9 , RCONIO , RRHO , TEMP , TEMPO 


GO  TO  715 

705  YPSIS  - PREPSI  + (XPST(LPS2) 

* (VAR(l)  - PREX)) 
RHOURT  - PRERU  + (XPST(LPS2) 

* (VAR(l)  - PREX)) 

TEMP  - PRETEP  + (XPST(LPS2)  - 

* - (VAR(l)  - PREX)) 

TEMPO  - PRET  + (XPST(LPS2)  - 

* (VAR(l)  - PRET)) 

RCON1  - PREC1  + (XPST(LPS2)  - 

* (VAR(l)  - PREX)) 

RCON2  - PREC2  4-  (XPST(LPS2)  - 

* (VAR(l)  - PREX)) 

RCON3  - PREC3  + (XPST(LPS2)  - 

* (VAR(l)  - PREX)) 

RC0N4  - PREC4  + (XPST(LPS2)  - 

* (VAR(l)  - PREX)) 

RCON5  - PREC5  + (XPST(LPS2)  - 

* (VAR(l)  - PREX)) 

RCON6  - PREC6  + (XPST(LPS2)  - 

* (VAR(l)  - PREX)) 

RC0N7  - PREC7  + (XPST(LPS2)  - 

* (VAR(l)  - PREX)) 

IF  (IMAX. EQ. 10)  THEN 

RCON8  - PREC8  + (XPST(LPS2)  - 

* (VAR(l)  - PREX)) 

RC0N9  - PREC9  + (XPST(LPS2)  - 

* (VAR(l)  - PREX)) 

RCONIO  - PREC10  + (XPST(LPS2) 

* (VAR(l)  - PREX)) 

END  IF 


- PREX)*( (PSIS  - PREPSI)/ 

- PREX)*((RHO*U  - PRERU)/ 
PREX)*( (TVI(l)  - PRETEP)/ 

PRET)*( (T  - PRET)/ 

PREX)*( (VAR(3)  - PREC1)/ 
PREX)*( (VAR(4)  - PREC2)/ 
PREX)*( (VAR(5)  - PREC3)/ 
PREX)*((VAR(6)  - PREC4)/ 
PREX)*( (VAR(7)  - PREC5)/ 
PREX)*( (VAR(8)  - PREC6)/ 
PREX)*( (VAR(9)  - PREC7)/ 

PREX)*((VAR(10)  - PREC8)/ 
PREX)*( (VAR(ll)  - PREC9)/ 

- PREX)*((VAR(12)  - PREC10)/ 


RRHO  - PRERHO  + (XPST(LPS2)  - PREX)*((RHO  - PRERHO)/ 
• (VAR(l)  - PREX)) 

RHOURT  - 1 . 0 /RHOURT 


WRITE (14 , *)  IPSI ,RH0URT,XPST(LPS2) .YPSIS 
WRITE(16 ,*)  LPS2.JJJ 

IF  (IMAX.EQ.7)  WRITE(16 ,*)  RC0N1 , RCON2 , RCON3 , RCON4 , RCON5 , 

* RCON6,RCON7,RRHO, TEMP .TEMPO 

IF  (IMAX.EQ.10)  WRITE ( 16 ,*)  RCONl,RCON2.RCON3,RCON4,RCON5,RCON6 

* , RCON7 , RCON8 , RCON9 . RCONIO , RRHO . TEMP , TEMPO 
715  LPS2  - LPS2  + 1 

KSTAG  - KSTAG  + 1 
720  PREX  - VAR(l) 

PRERU  - RHO*U 
PREPSI  - PSIS 
PRETEP  - TVI(l) 

PRET  - T 
PREC1  - VAR(3) 

PREC2  - VAR(4) 

PREC3  - VAR(5) 

PREC4  - VAR(6) 

PREC5  - VAR(7) 

PREC6  - VAR(8) 

PREC7  - VAR(9) 

IF  (IMAX.EQ.10)  THEN 
PREC8  - VAR(IO) 

PREC9  - VAR(ll) 

PREC10  - VAR(12) 

END  IF 

PRERHO  - RHO 

IF  (VAR(l) .LT.VARI(IZTERM))  GO  TO  505 
C END  OF  STREAMLINE 

WRITE(*, 725) 

WRITE(8 , 725) 

725  FORMAT ( IX, 'XXXXXXXXXXXXXXXX'/) 

IF  ((IPSI. EQ. (NSR+1)) .AND. (ISTAG.EQ.l))  GO  TO  425 
730  GO  TO  420 

C COMPUTE  PHYSICAL  SPACE  VALUES 

735  WRITE(15 , *)  KSTAG 
CLOSE(IO) 

CLOSE(ll) 

CLOSE (12) 

CL0SE(13) 

CLOSE (15) 

CL0SE(16) 

WRITE(* , 740)  KSTAG 
WRITE(8 , 740)  KSTAG 

740  FORMAT (IX, 'BEGIN  PHYSICAL  SPACE  CALCULATIONS  KSTAG  - ',15/) 

OPEN (UNIT-17 , FILE- ' RADIN3 . DAT ' , STATUS- 'UNKNOWN' ) 

C 

LPS3  - 0 

DO  840  LPS  - 1 , NXPST 
CLOSE (14) 

OPEN  (UNIT-14 , FILE- ' RHORT . DAT ' , STATUS- ' OLD ' ) 

IK  - 0 

745  LPS 3 - LPS 3 + 1 

IF  (LPS3 . GT. IZTERM)  GO  TO  840 

IF  (DABS (XI (LPS 3)  - XPST(LPS)) .GT.1.0E-08)  GO  TO  745 

DO  780  IPS  - 1, KSTAG 

READ (14,*)  IPSI, RHOURT, VAR(l) , PSIS 

VARMX  - VAR(l)  - XPST(LPS) 

IF  (DABS (VARMX). GT.1.0E-08)  GO  TO  780 
IK  - IK  + 1 
IBOB  - IK  - 1 


o o 


IF  (IK.GT.200)  WRITE(*, 770)  IK 

770  FORMAT (IX, 'IK.GT.200 .CHANGE  DIMENSION  OF  RUT  AND  PSISTG, IK  - ',13) 

RUT (IK)  - RHOURT 
PSISTG(IK)  - PSIS 
780  CONTINUE 

C FIND  SMALLEST  DELTA  PS I 

SMALL  - 200.0 
DO  785  I - 2, IK 

IF  ( (PSISTG(I)  - PSISTG(I-l)) .LT. SMALL)  SMALL-  PSISTG(I) 

* - PSISTG(I-i) 

785  CONTINUE 

XDEL  - PSISTG (IK) /SMALL 

C TRUNCATE 

L - I NT (XDEL  +1.0) 

C REMAINDERING  M - 0 FOR  EVEN,  M - 1 FOR  ODD 

M - MOD ( L , 2 ) 

C MAKE  L EVEN 

IF  (M.NE.O)  L - L + 1 

FIND  INTEGRAL  l./(RHO*U)  DELTA  PSI  FROM  BODY  TO  SHOCK 
USING  SIMPSONS  RULE  ; L INCREMENTS  , L+l  POINTS 

FL  - L 

DPSIS  - PSISTG(IK) /FL 
PSII  - 0.0 

RB  - RUT ( 1 ) + RUT (IK) 

DO  800  I - 2,L,2 

PSII  - PSII  + DPSIS 

CALL  FTLUP  (PSII ,RU1, 1, IK, PSISTG, RUT) 

IF  (I.EQ.L)  RB  - RB  + 4.0+RU1 
IF  (I.EQ.L)  GO  TO  800 
PSII  - PSII  + DPSIS 

CALL  FTLUP  (PSII ,RU2 , 1 , IK, PSISTG , RUT) 

RB  - RB  + 4.0*RU1  + 2.0+RU2 
800  CONTINUE 

RB  - RB+DPSIS/3 . 0 

ARR  - DSQRT(RSM(LPS3)**2  - 2 . 0*C0STM(LPS3)*RB) 

YI  - (RSM(LPS3)  - ARR)/COSTM(LPS3) 

WRITE(17 , *)  IBOB.IK 
WRITE(17 ,*)  YI 

ZE  - ZSM(LPS3)  + YI  *S INTM ( LPS  3 ) 

WRITE(*, 815)  PSISTG(l) ,X1(LPS3) ,ARR,YI,ZE 
WRITE (8 , 815)  PSISTG(l) ,X1(LPS3) ,ARR,YI,ZE 
815  FORMAT (IX, 'PSI  - ' , E12 . 5 ,/, IX, 'X  - ' , E13 . 6 , 3X, 'R  - '.E13.6 

* , 3X,'Y  — ' , E13 . 6 , 3X, ' Z — '.E13.6/) 

DO  830  I - 2, IK 

DPSI  - PSISTG(I)  - PSISTG(I-l) 

TRAPEZOIDAL  RULE 

TR  - (DPS 1/2 . 0)*(RUT(I)  + RUT(I-l)) 

RB  - RB  - TR 

ARR  - DSQRT(RSM(LPS3)**2  - 2 . 0*COSTM(LPS3)*RB) 

YI  - (RSM(LPS3)  - ARR) /COSTM(LPS3) 

WRITE (17,*)  YI 

ZE  - ZSM(LPS3)  + YI*SINTM(LPS3) 

WRITE(8 , 815)  PSISTG(I) ,X1(LPS3) ,ARR,YI,ZE 
WRITE(*, 815)  PSISTG(I) ,X1(LPS3) ,ARR,YI,ZE 
830  CONTINUE 

WRITE(8 , 835) 

WRITE(*, 835) 

835  FORMAT (//) 

840  CONTINUE 
845  WRITE(8 , 850) 


ooooooooooo  ooooooo 


WRITE(*,850) 

850  FORMAT (IX, 'END  THIS  CASE  , HALLELUJAH  '/) 
CLOSE (8) 

CL0SE(14) 

CL0SE(17) 

STOP 

END 


SUBROUTINE  BASIC 

BASIC  CALLED  BY  CALINTH  TO  EVALUATE  DERIVATIVES  H DOT, 

C SUB  I DOT  AND  EV  SUB  I DOT  ; DERIVATIVES  START  IN  DER(l) 


IMPLICIT  REAL*8 (A-H.O-Z) 

COMMON  /Al/  M, IX, IMAX.IPSI, MODEL, TE1.TE2 
COMMON  /A2/  P(200) ,DPDX(200) ,VARI(200) 

COMMON  /A3/  EVIINF(25) ,THETAI(25) ,MUI(25) ,FI(25) ,DELHI(25) , 

* CIINF(25) ,LI(25) 

COMMON  /A4/  R.MUINF, DELTA, LAMSQ , OMEGSQ , OMEGA, MU, T,U,TINF 
COMMON  /A5/  EPSIIL(20,25) ,GIL(20,25) ,CID(200,4) 

COMMON  /A6/  VAR(52) ,CUVAR(52) ,DER(51) 

COMMON  /A7/  MJ(50) ,EJ(50) ,AJ(50) ,BJ(50) .DIRECT (50) 

COMMON  /A8/  TVI(25) ,NI(25) ,DGENI(25) ,BI(25) 

COMMON  /A10/  NUIJ (26,50) ,AIJ (25,50) ,NUPIJ (25,50) 

COMMON  /All/  SIGIK(25 , 25) ,ALPIK(25 , 25) , BETAIK(25 , 25) 

COMMON  /A13/  DEIX, ZSTERM, IZTERM, NSR.MW, SP , TS 
COMMON  /Al4/  EINF , PINF , RHOINF , VINF , E , JMAX , KEYINT , RHO , HSTAG 
COMMON  /A15/  PFTL,KITR1,NIP(25),UP(25) 

COMMON  /A16/  IUNEG,WE(25) ,WEXE(25) ,WEYE(25) ,WEZE(25) 

COMMON  /A18/  ITNEG , IEXP 

DIMENSION  PHI (50) ,SJ(50) ,DCIJDX(50) ,EVP(100) 

DIMENSION  CI(25) ,EVI(25) ,DCIDX(25) ,DEVIDX(25) , EVIBAR(25) 

EQUIVALENCE  (CUVAR(2) ,H) , (CUVAR(3) , Cl (1) ) 

EQUIVALENCE  (DER(l) , DHDX) , (DER(2) ,DCIDX(1))- 
REAL*8  KPJ,KEQ,KJ(50) .LAMSQ, MU ,MUI,MUIOT,MUINF,ND 

DER(l)  - DHDX  MUST  BE  DHDX  AS  H MAY  BE  + OR  - 

DER(2)  - DCIDX(l) 

DER(1+IMAX)  - DCIDX(IMAX) 

DER(1+IMAX+1)  - DEVIDX(l) 

DER ( 1+IMAX+IMAX)  - DEVIDX(IMAX) 

CUVAR(l)  - X 

CUVAR(2)  - H, ENTHALPY  - IT  MUST  BE  H WHICH  MAY  BE  + OR  - 
CUVAR(3)  - CI(1) 

C 

C CUVAR ( 2+IMAX ) - CI(IMAX) 

C CUVAR (2+IMAX+l)  - EVI(l) 

C CUVAR ( 2+IMAX+IMAX ) - EVI(IMAX) 

C 

C KEYINT  - 1 AT  END  OF  1ST  INTERVAL 

IF  (ITNEG. EQ.l. OR. IEXP. EQ.l)  RETURN 
IF  (M.NE.O)  GO  TO  10 
DO  5 I - 1 , IMAX 
J1  — I + IMAX  + 2 
5 CUVAR(Jl)  - VAR(Jl) 

C INTERPOLATE  FOR  P ACROSS  INTEGRATION  INTERVAL 


Mb  0 


10  DO  15  I - l.IMAX 
15  EVI(I)  - CUVAR ( 2+IMAX+I ) 

MFTL  - 1 

NFTL  - IZTERM  - IPSI  + 1 

CALL  FTLUP  (CUVAR(l)  ,PFTL, MFTL, NFTL, VARI(IPSI)  ,P(IPSI)) 

INTERPOLATE  FOR  DPDX 

CALL  FTLUP  (CUVAR(l)  .DPFTL, MFTL, NFTL, VARI(IPSI)  .DPDX(IPSI)) 

IF  (KEYINT.EQ.O)  GO  TO  95 

SUM  - 0.0 

DO  45  I - l.IMAX 

USE  SHOCK  VALUES  FOR  INITIAL  COMPUTATION  ON  EACH  STREAMLINE 
SUM  - SUM  + CI(I)/MUI(I) 

IF  (EVI(I) .EQ.0.0)  TVI(I)  - 0.0 
IF  (EVI(I) .EQ.0.0)  GO  TO  45 

XL  - ( (DGENI (I)*R*THETAI (I) )/ (MUI (I)*EVI (I) ) + 1.0) 

ALN  - DLOG(XL) 

COMPUTE  TVI 

TVI(I)  - THETAI ( I ) /ALN 
45  CONTINUE 
MU  - 1.0/SUM 
U2  - 2 . 0*(HSTAG  - H) 

IF  (U2.LT.0.0)  WRITE(* , 50)  H 
50  FORMAT ( IX, 'U**2  IS  NEG  IN  BASIC  , H - ’,E11.4,2X, 

* 'END  STREAMLINE  INTEGRATION') 

IF  (U2.LT.0.0)  IUNEG  - 1 
. IF  (U2.LT.0.0)  RETURN 
U - DSQRT(U2) 

ITERATE  FOR  E 

KCODE  - 0 
55  KITR1  - 0 
ICODE  - 0 
MAXI  - 50 
TOL1  - .001 
TOL2  - .00001 

CALL  FOFE  (MAXI , TOL1 ,T0L2 , ICODE, E) 

IF  ( ICODE. EQ.O)  GO  TO  75 
IF  (ICODE. EQ.l)  WRITE(* , 60) 

60  FORMAT (IX, '*  MAXIMUM  ITERATION  EXCEEDED  IN  SUB  BASIC  *:  STOP  66'/) 

IF  (ICODE. EQ. 2)  WRITE(*,65) 

65  FORMAT ( IX , '***  DERIVATIVE  - 0 IN  SUB  BASIC  ****  : STOP  66'/) 

WRITE(*,70)  ICODE 

70  FORMAT (IX, 'ICODE  - ',12,'  IN  SUB  BASIC  '/) 

IF  (ICODE. NE.l)  STOP 
IF  (KCODE. EQ. 3)  STOP 

WHEN  ICODE  - 1,  TRY  A NEW  STARTING  E.  DO  THIS  2 TIMES  ; STOP  66 
KCODE  - KCODE  + 1 
GO  TO  55 

75  IF  (IEXP.NE.l)  GO  TO  85 
KCODE  - KCODE  + 1 
I EXP  - 0 

IF  (KCODE. EQ.l)  GO  TO  55 
IF  (KCODE. GT. 2)  RETURN 
E - H - H*l. E-05 
GO  TO  55 

85  RHO  - PFTL/(H  - E) 

T - (PFTL*MU)/(RHO*R) 

IF  (T.GT.0.0)  GO  TO  95 
WRITE(*, 90)  T , RHO, PFTL.H , E,MU 


90  FORMAT (IX, 'T  NEGATIVE  - ' . E12 . 4 , IX, 'RHO  - ' , Ell . 4 , IX , ’ PFTL  - ', 

* Ell. 4,/, IX, 'H  - ' , Ell. 4, IX, 'E  - ', Ell. 4, IX, 'MU  - '.E11.4.2X, 

* 'IN  SUB  BASIC'/) 

E - H - H*1.0E-06 
ITNEG  - 1 

RETURN 

95  KEYINT  - 1 

PI  - 4 . 0*ATAN (1.0) 

BC  - 1 . 38054E-16 
AVGN  - 6 . 02252E+23 

C COMPUTE  DCIDX  AND  DEVIDX  FOR  EACH  SPECIE  I 

DO  210  I - l.IMAX 
DCIDX(I)  - 0.0 
CVSUM1  - 0.0 
CVSUM2  - 0.0 

C CORRECTED  RELAXATION  TIME  FOR  PARK  MODEL 

IF  (MODEL.EQ.4.AND.I.EQ.1)  THEN 
ND  - RHO*AVGN*CI ( I ) /MUI ( I ) 

SIGMAV  - 10. OE-17*(50000./T)**2 
C - DSQRT(8 . *AVGN*BC*T/(PI*MUI(I) ) ) 

TAUC  - 1.0/(C*SIGMAV*ND) 

END  IF 

C FOR  EACH  REACTION  J 

DO  190  J - l.JMAX 
ICT  - MOD(J ,2) 

C II  IS  THE  SELECTED  SPECIE  FOR  REACTION  J 

KNT  - 0 

IF  (ICT.EQ.l)  THEN 
IF  (DIRECT(J) .EQ.1.0)  PHIC  - 1.0 
IF  (DIRECT (J) . EQ . 2 . 0)  PHIC  - 2.0 
II  - MJ (J) 

100  IF  (M.EQ.O)  GO  TO  115 

IF  (FI(II) .NE.0.0)  GO  TO  120 
115  IF  (PHIC. EQ.1.0)  PHI (J ) - 1.0 
IF  (PHIC. EQ. 2.0)  PHKJ+l)  - 1.0 
GO  TO  125 

120  IF  (MODEL. EQ. 3. AND. UP(II) .NE.0.0)  GO  TO  122 
TEM  - DEXP (THETAI (II) /TVI (II)) 

TEM1  - DEXP (THETAI ( II )/T) 

TEM2  - DEXP (-NI (II)* (THETAI (II) /TVI (II)  - THETAI (II)/T) ) 

TEM3  - DEXP (THETAI (II) /TVI (II)  - THETAI (II)/T) 

IF  (TEM3. EQ.1.0. AND. PHIC. EQ.1.0)  PHI(J)  - 1.0 
IF  (TEM3. EQ.1.0. AND. PHIC. EQ. 2.0)  PHI(J+1)  - 1.0 
IF  (TEM3. EQ.1.0)  GO  TO  125 

C PHI  - COUPLING  COEFF.;  FOR  CVD.CVDV  AND  PARK  MODEL 

IF  (PHIC. EQ.1.0)  PHI (J)  - ( (1 . 0-TEM2)/(TEM3-l . 0)*(TEM  - 1.0) 

* /(TEM1  - 1.0) )/NI (II) 

IF  (PHIC. EQ. 2.0)  PHI(J+1)  - ((1.0-TEM2)/(TEM3-1.0)*(TEM  - 1.0) 

* / (TEM1  - 1.0) )/NI (II) 

GO  TO  125 

122  USUM  - 0.0 
TSUM  - 0.0 
TFSUM  - 0.0 
TVTSUM  - 0.0 

TF  - 1 . 0/(1 . /TVI (II)  - l./T  - l./UP(II)) 

NIC  - NIP(II)  + 1 
DO  123  N - 1 , NIC 
XN  - N 

EEVP  - XN  - 0.5 

EVP(N)  - EEVP* (WE (II)  + EEVP*( -WEXE(II)  + EEVP*(WEYE(II)  + 


* WEZE(II)*EEVP) ) ) 

EVP(N)  - EVP(N)  - EVP ( 1 ) 

USUM  - USUM  + DEXP(EVP(N)/UP(II) ) 

TSUM  - TSUM  + DEXP(-EVP(N)/T) 

TFSUM  - TFSUM  + DEXP( -EVP(N)/TF) 

123  TVTSUM  - TVTSUM  + DEXP(-EVP(N)/TVI(II)) 

C ' COUPLING  COEFF.  FOR  CVDV- PREFERENTIAL  MODEL 

IF  (PHIC.EQ.1.0)  PHI (J)  - ( TSUM*TFSUM) / (USUM*TVTSUM ) 

IF  (PHIC.EQ.2.0)  PHI (J+l)  - (TSUM*TFSUM)/(USUM*TVTSUM) 

125  KNT  - KNT  + 1 

IF  (KNT. EQ.l. AND. PHIC.EQ.1.0)  THEN 
PHIC  - 2.0 
II  - MJ (J+l) 

GO  TO  100 
END  IF 

IF  (KNT. EQ.l. AND. PHIC.EQ.2.0)  THEN 
PHIC  - 1.0 
II  - MJ (J+l) 

GO  TO  100 
ENDIF 

C START  OF  LOOP  TO  DETERMINE  EQUILIBRIUM  CONSTANT 

BETAJ  - 0.0 
FJORT  - 0.0 
DO  130  K - 1 , IMAX 
SUMG  - 0.0 
LI  I - LI  (K) 

DO  128  L - l.LII 

128  SUMG  - SUMG  + GIL(L,K)*DEXP(-EPSIIL(L,K)/T) 

C MUIOT  - (CHEMICAL  POTENTIAL) /T 

MUIOT  - - (BI(K)  + (5.  + 2 . *FI (K) ) /2 . *(DLOG (TINF)  + 

* DLOG (T/TINF) ) + FI(K)*DLOG(l./(l.  - DEXP( -THETAI (K)/T) ) ) 

* + DLOG(SUMG/GIL(l ,K) ) ) + DELHI (K)/(R*T) 

BETAJ  - BETAJ  + (NUPIJ(K.J)  - NUIJ(K.J)) 

130  FJORT  - FJORT  + (NUPIJ(K.J)  - NUIJ (K, J) )*MUIOT 
C KPJ  - EQUIL.  CONST.  (IN  TERMS  OF  PARTIAL  PRESSURES) 

KPJ  - DEXP( -FJORT) 

C KEQ  - EQUILIBRIUM  CONSTANT 

KEQ  - KPJ* (9 . 868 8225E-07*R*T)**( -BETAJ) 

C KJ  - RATE  CONSTANT  (FORW:  J - 1,3,.  BACK:  J - 2,4,.) 

IF  (DIRECT(J) .EQ.1.0)  THEN 
KJ (J ) - AJ (J)*T**BJ (J)*DEXP(-EJ (J)/T) 

IF  (J.EQ.19)  KJ (J)  - AJ(J)*TVI(1)**BJ(J)*DEXP(-EJ(J)/TVI(1)) 

KJ (J+l)  - KJ (J) /KEQ 
ELSE 

KJ (J+l)  - AJ(J)*T**BJ(J)*DEXP(-EJ(J)/T) 

IF  (J.EQ.19)  KJ (J+l)  - AJ (J)*TVI (1)**BJ (J)*DEXP( -EJ (J)/TVI (1) ) 

KJ (J ) - KJ (J+1)*KEQ 
ENDIF 
ENDIF 

IF  (NUIJ (IMAX+1 , J) . EQ . 0)  SJ(J)  - 1.0 
IF  (NUIJ (IMAX+1 , J) . EQ . 0)  GO  TO  140 
SUM  - 0.0 

DO  135  I SUM  - 1 , IMAX 

135  SUM  - SUM  + AIJ (ISUM, J)*CI(ISUM)/MUI(ISUM) 

SJ(J)  - RHO*SUM 
140  PROD  -1.0 

DO  180  IPROD  - 1 , IMAX 

IF  ( NUI J( IPROD, J) .EQ.O)  GO  TO  180 

TEM  - RHO*CI( IPROD) /MUI (IPROD) 

IF  (TEM. GE. 0.0)  GO  TO  165 


UP 


LET  PROBLEM  COMPUTE  PROD.  WHEN  Cl  NEG  ; DECIDE  IN  MAIN  ABOUT  ACCEPTING  NEG  Cl 
LABW  - MOD(NUIJ (IPROD, J) , 2) 

LABW  - 0 FOR  EVEN  NUIJ , ABW  - 1 FOR  ODD  NUIJ 
IF  (LABW.EQ.O)  PROD  - PROD*( - TEM) **NUIJ( IPROD, J) 

IF  (LABW.EQ.l)  PROD  - -1.0*PROD*(-TEM)**NUIJ(IPROD,J) 

GO  TO  180 

165  PROD  - PROD*TEM**NUIJ( IPROD, J) 

180  CONTINUE 

IF  (ICT.EQ.l)  PRODF  - PROD 
BETAIJ  - NUPIJ(I.J)  - NUIJ (I, J) 

DCIJDX(J)  - PHI(J)*KJ(J)*SJ(J)*(MUI(I)/(RHO*U))*PROD*BETAIJ 

DCIDX  - RATE  OF  PRODUCTION  OF  THE  CONCENTRATION  OF  SPECIE  I 
DCIDX(I)  - DCIDX(I)  + DCIJDX(J) 

IF  (ICT.EQ.O. AND. MODEL. GT.l)  THEN 

QIJ  - NET  RATE  OF  PRODUCTION 

QIJ  - DCIJDX(J-l)  + DCIJDX(J) 

DENOM  - KEQ*PHI (J-1)*SJ (J-l)*PRODF 
IF  (DENOM. EQ. 0.0)  GO  TO  190 

CHI  - DEGREE  OF  NON- EQUILIBRIUM 

CHI  - 1.0  - (PHI (J)*SJ ( J)*PROD/DENOM) 

DEN0M1  - CI(I)*CHI 
IF  (DENOM1 . EQ . 0 . 0)  GO  TO  190 
CVSUM1  - CVSUM1  + QIJ/DENOM1 
CVSUM2  - CVSUM2  + QIJ* (1.0  - CHI)/DEN0M1 
END  IF 

190  CONTINUE 

TEM  - DEXP(THETAI(I)/T) 

TEM1  - ( FI ( I ) *DGENI ( I ) *R*THETAI ( I ) ) /MUI ( I ) 

EVIBAR(I)  - T EMI/ (TEM  - 1.0) 

IF  (M.NE.O)  GO  TO  195 
VAR(I+IMAX+2)  - EVIBAR(I) 

DEVIDX(I)  - 0.0 
GO  TO  210 
195  TAUSUM  - 0.0 

IF  (FI (I) .EQ.0.0)  GO  TO  210 

CVD  MODEL 

DO  200  K - l.IMAX 

TEM3  - DEXP ( - THETAI ( I ) /T) 

TEM4  - DEXP(SIGIK(K, I)*T**( -1 . /3 . ) ) 

TEM5  - (FI (I)*ALPIK(K, I) ) /PFTL 

TAUIK  - TEM5*(T**BETAIK(K, I)*TEM4)/(1 . 0 - TEM3) 

MILLIKAN  & WHITE  RELAXATION  DATA 

IF  (MW. EQ. 1)  THEN 

IF  (I.EQ.l)  TAUIK  - 1.9E-05*DEXP(216.45*T**(-l./3.))/PFTL 
IF  (I.EQ.8)  TAUIK  - 3 . 1845E-05*DEXP(198 . 66*T**(-l./3 . ) )/PFTL 
ENDIF 

TEM6  - CI(K)*(EVIBAR(I)  EVI(I)) 

PARK  MODEL 

IF  (MODEL. EQ. 4. AND. I.EQ.l)  THEN 
TAULP  - TAUIK  + TAUC 

PF  - DABS ( (T  - TVI(I) )/(TS  - TINF))**(SP  - 1.) 

TAUSUM  - TAUSUM  + (TEM6/(TAULP*U) )*PF 
GO  TO  200 
ENDIF 

TAUSUM  - TAUSUM  + TEM6/(TAUIK*U) 

200  CONTINUE 

IF  (MODEL. EQ.l)  GO  TO  207 
IF  (MODEL. EQ. 3)  GO  TO  202 


ADDITIONAL  TERMS  FOR  CVDV  & PARK  MODEL 


IF  ( I . EQ . 5 . OR . I . EQ . 6 . OR . I . EQ . 8 ) GO  TO  207 
TEM7  - DEXP (THETAI ( I ) /TVI ( I ) - THETAI(I)/T) 

TEM8  - DEXP (NI  ( I ) *THETAI  ( I ) /TVI  ( I ) ) *DEXP  ( - NI  ( I ) *THETAI  ( I ) /T  ) 

CVDVT  - ( (THETAI ( I )/(TEM7  - 1.)  - NI(I)*THETAI(I)/(TEM8  - 1.)) 

* *R/MUI ( I ) - EVI ( I ) ) *CVSUM1  - ((0.5*(NI(I)  - 1 . ) *THETAI ( I ) 

* *R/MUI ( I ) ) - EVI ( I ) ) *CVSUM2 
TAUSUM  - TAUSUM  + CVDVT 

GO  TO  207 

C ADDITIONAL  TERMS  FOR  CVDV- PREFERENTIAL  MODEL 

202  IF  ( I . EQ . 5 . OR . I . EQ . 6 . OR . I . EQ . 8 ) GO  TO  207 
USUM1  - 0.0 
USUM2  - 0.0 
TFSUM1  - 0.0 
TFSUM2  - 0.0 
NIC  - NIP(I)  + 1 

TF  - 1. 0/(1. /TVI (I)  - l./T  - l./UP(I)) 

DO  204  N - l.NIC 
XN  - N 

EEVP  - XN  - 0.5 

EVP(N)  - EEVP*(WE(I)  + EEVP* ( - WEXE ( I ) + EEVP*(WEYE(I)  + 

* WEZE (I)*EEVP))) 

EVP(N)  - EVP(N)  - EVP ( 1 ) 

USUM1  - USUM1  + DEXP(EVP(N)/UP(I) ) 

USUM2  - USUM2  + EVP(N)*DEXP(EVP(N)/UP(I) ) 

TFSUM1  - TFSUM1  + DEXP( -EVP(N)/TF) 

204  TFSUM2  - TFSUM2  + EVP(N)*DEXP(-EVP(N)/TF) 

GBAR  - (USUM2/USUM1)*(R/MUI (I) ) 

EBAR  - (TFSUM2/TFSUM1)* (R/MUI ( I ) ) 

CVDVPT  - (EBAR  - EVI (I) )*CVSUM1  - (GBAR  - EVI ( I ) ) *CVSUM2 
TAUSUM  - TAUSUM  + CVDVPT 

C DEVIDX  - EQUILIBRIUM  VIBRATIONAL  ENERGY 

207  DEVIDX(I)  - TAUSUM 

DER ( 1+IMAX+I ) - DEVIDX(I) 

210  CONTINUE 

C COMPUTE  DHDX 

DHDX  - DPFTL/RHO 
RETURN 
END 
C 

c 

c 

SUBROUTINE  FOFE  (MAXI , TOL1 , TOL2 , ICODE , El) 

C 

C CALLED  BY  SUB  BASIC  TO  EVALUATE  E BY  NEWTON  ITERATION  TECHNIQUE 
C 

IMPLICIT  REAL*8 (A-H, O-Z) 

COMMON  /Al/  M, IX, IMAX.IPSI, MODEL, TE1.TE2 
COMMON  /A2/  P(200) ,DPDX(200) ,VARI(200) 

COMMON  /A3/  EVIINF(25) .THETAI (25) ,MUI(25) ,FI(25) .DELHI (25) , 

* CIINF(25) ,LI(25) 

COMMON  /A4/  R.MUINF, DELTA, LAMSQ.OMEGSQ, OMEGA, MU, T.U.TINF 
COMMON  /A5/  EPSIIL(20 , 25) , GIL(20 , 25) , CID(200 ,4) 

COMMON  /A6/  VAR(52) ,CUVAR(52) ,DER(51) 

COMMON  /A7/  MJ(50) ,EJ(50) ,AJ(50) ,BJ(50) , DIRECT (50) 

COMMON  /A8/  TVI (25) , NI (25) , DGENI (25) ,BI(25) 

COMMON  /A10/  NUIJ (26,50) , AIJ (25,50) ,NUPIJ (25,50) 

COMMON  /A15/  PFTL.KITRl ,NIP(25) ,UP(25) 

COMMON  /A18/  ITNEG.IEXP 
DIMENSION  Cl (25) 

EQUIVALENCE  ( CUVAR( 3 ) , Cl ( 1 ) ) , ( CUVAR (2) ,H) 


REAL* 8 MUI , LAMSQ , MUINF , MU 


IF  ( IEXP . EQ . 1 . OR . ITNEG . EQ . 1 ) RETURN 
KITR1  - KITR1  + 1 
ITER  - 0 
PORHO  - H - El 
T - PORHO*MU/R 
1 ITER  - ITER  + 1 
E - 0.0 
DE  - 0.0 

DO  35  I - l.IMAX 
IF  (TVI(I) .EQ.0.0)  THEN 
TEM1  - (1.5*R*T)/MUI(I)  + (FI(I)*R*T)/MUI(I) 

DTEM1  - 1 . 5*R/MUI ( I ) + FI(I)*R/MUI(I) 

GO  TO  15 
ENDIF 

TEM  - DEXP (THETAI ( I ) /TVI ( I ) ) 

TEM1  - ( 1 . 5*R*T) /MUI ( I ) + (FI(I)*R*T)/MUI(I)  + 

* (FI(I)*R*THETAI(I))/(MUI(I)*(TEM  - 1.0)) 

DTEM1  - 1 . 5*R/MUI ( I ) + FI(I)*R/MUI(I)  + ( R*FI ( I ) *THETAI ( I ) **2 ) 

* /(MUI(I)*TVI(I)**2)*(TEM/(TEM  - 1.0)**2) 

15  SUMG  - 0.0 

SUMGE  - 0.0 
DSUMGE  - 0.0 
LI  I - LI  (I) 

DO  25  L - l.LII 
TEM3  - - EPSIIL(L, I)/T 
IF  (TEM3.LT.741.67)  GO  TO  22 
IEXP  - 1 
RETURN 

22  TEM2  - DEXP(TEM3) 

SUMG  - SUMG  + GIL(L, I)*TEM2 
SUMGE  - SUMGE  + GIL(L, I)*EPSIIL(L, I)*TEM2 
IF  (SUMGE.LT. 1.0D+34)  GO  TO  25 
IEXP  - 1 
RETURN 

25  DSUMGE  - DSUMGE  + TEM2*GIL(L, I)*EPSIIL(L, I)**2 

DEVI  - R/MUI(I)*(((SUMG*DSUMGE/T**2)  - (SUMGE/T)**2) 

* /SUMG**2) 

DEI  - DTEM1  + DEVI 

El  - TEM1  + R/MUI (I)*(SUMGE/SUMG)  + DELHI ( I ) /MUI ( I ) 

DE  - DE  + DEI*CI (I) 

E - E + EI*CI (I) 

35  CONTINUE 

IF  (E.GT.H)  ITNEG  - 1 
DFT  - - DE 
FT  - El  - E 
IF  (DFT. EQ.0.0)  THEN 
ICODE  - 2 
RETURN 
ENDIF 

TS1  - T - (FT/DFT) 

DELT  - DABS (TS1  - T) 

T - TS1 

El  - H - R*T/MU 
IF  ( ITER. GE. MAXI)  THEN 
ICODE  - 1 
RETURN 


non  no 


ENDIF 

IF  (DELT.GT.T0L1)  THEN 
ITER1  - ITER 
GO  TO  1 
ENDIF 

ITER2  - ITER1  + 10 

IF  ( DELT . LE . TOL2 . OR . ITER . GE . ITER2 ) RETURN 

GO  TO  1 

END 


SUBROUTINE  FOFTS1  (MAXI ,T0L1 ,TOL2 , ICODE.TSG) 

CALLED  BY  MAIN  TO  EVALUATE  TS  BY  NEWTON  ITERATION  TECHNIQUE 

IMPLICIT  REAL*8(A-H,0-Z) 

COMMON  /Al/  M, IX, IMAX, IPSI , MODEL, TE1.TE2 
COMMON  /A2/  P(200) ,DPDX(200) ,VARI(200) 

COMMON  /A3/  EVIINF(25) ,THETAI(25) ,MUI(25) ,FI(25) ,DELHI(25) 

* ,CIINF(25) ,LI(25) 

COMMON  /A4/  R.MUINF, DELTA, LAMSQ.OMEGSQ, OMEGA, MU, T.U.TINF 
COMMON  /A5/  EPSIIL(20 , 25) ,GIL(20,25) ,CID(200,4) 

COMMON  /A6/  VAR(52) ,CUVAR(52) ,DER(51) 

REAL* 8 MUI , LAMSQ , MUINF , MU 

C 

ITER  - 0 

1 ITER  - ITER  + 1 
ES  - 0.0 
DES  - 0.0 
DO  25  I - 1 , IMAX 
IF  (M.EQ.l)  EVIS  - EVIINF(I) 

IF  (M.EQ.l)  GO  TO  5 
TEM  - DEXP ( THETAI ( I ) /TS  G ) 

EVIS  - (R*THETAI (I) )/(MUI (I)*(TEM-1 . 0) )*FI (I) 

DEVIS  - (R*FI ( I ) *THETAI ( I ) **2 ) / (MUI ( I ) *TSG**2 ) * (TEM/ (TEM- 1 . 0 ) **2 ) 
5 SUMG  - 0.0 
SUMGE  - 0.0 
DSUMGE  - 0.0 
LI  I - LI  (I) 

C 

DO  10  L - l.LII 

TEM1  - DEXP ( - EPSIIL(L,I)/TSG) 

SUMG  - SUMG  + TEM1*GIL(L, I) 

SUMGE  - SUMGE  + TEM1*GIL(L, I)*EPSIIL(L, I) 

10  DSUMGE  - DSUMGE  + TEM1*GIL(L, I)*EPSIIL(L, I)**2 
EEIS  - (R/MUI (I) )*(SUMGE/SUMG) 

DEEIS  - R/MUI (I)*( ( (SUMG*DSUMGE/TSG**2)  - (SUMGE/TSG)**2) 

* /SUMG** 2) 

EIS  - (1 . 5*R*TSG) /MUI (I ) + (FI (I)*R*TSG)/MUI (I)  + EVIS  + EEIS 

* + DELHI ( I ) /MUI ( I ) 

DEIS  - 1 . 5*R/MUI (I)  + FI ( I ) *R/MUI ( I ) + DEVIS  + DEEIS 
ES  - ES  + EIS*CIINF(I) 

DES  - DES  + DEIS*CIINF(I) 

25  CONTINUE 
C 

FAC  - DSQRT(OMEGSQ  - 2 . 0*LAMSQ* (DELTA  - ES)) 

FIN  = ( 2 . 0*MUINF* ( DELTA  - ES)*FAC)/(R*( OMEGA  + FAC)) 

FTS  - TSG  - FIN 

FAC1  - R* ( OMEGA+FAC )* (MUINF* ( DELTA -ES)*( 2 . 0/FAC) *LAMSQ*DES  - 


d o 


* 2 . 0*FAC*MUINF*DES ) - 2 .0*MUINF* (DELTA- ES)*R*LAMSQ*DES 
FAC 2 - R**2*( OMEGA  + FAC)**2 

DFTS  - 1.0  - FAC1/FAC2 
IF  (DFTS. EQ. 0.0)  THEN 
I CODE  - 2 
RETURN 
ENDIF 

TSG1  - TSG  - (FTS/DFTS) 

DELTS  - DABS(TSG1  - TSG) 

TSG  - TSG1 

IF  ( ITER. GE. MAXI)  THEN 
I CODE  - 1 
RETURN 
ENDIF 

IF  ( DELTS. GT. TOL1)  THEN 
ITER1  - ITER 
GO  TO  1 
ENDIF 

ITER2  - ITER1  + 10 

IF  (DELTS. LE.TOL2. OR. ITER. GE.ITER2)  RETURN 
GO  TO  1 
END 
C 

C 

c 

SUBROUTINE  CHECK 
C 

C CHECK  CALLED  BY  CALINTH  TO  MAKE  DECISION  TO  ACCEPT  ANSWERS 

C 

IF  ACCEPTABLE  ; SET  ELB  - 0 AND  RETURN 

IF  NOT  ACCEPTABLE  ; MODIFY  SPEC  AND  Cl  ; SET  ELB  - 1.0  AND  RETURN 
C 

IMPLICIT  REAL*8(A-H,0-Z) 

COMMON  /Al/  M, IX, IMAX.IPSI, MODEL, TE1.TE2 
COMMON  /A2/  P(200) ,DPDX(200) ,VARI(200) 

COMMON  /A3/  EVIINF(25) ,THETAI(25) ,MUI(25) ,FI(25) ,DELHI(25) , 

* CIINF(25) ,LI(25)  . 

COMMON  /A4/  R.MUINF, DELTA, LAMSQ.OMEGSQ, OMEGA, MU, T,U,TINF 
COMMON  /A5/  EPSIIL(20 ,25) ,GIL(20 ,25),CID(200,4) 

COMMON  /A6/  VAR(52) ,CUVAR(52) ,DER(51) 

COMMON  /A13/  DELX, ZSTERM , IZTERM,NSR,MW, SP , TS 
COMMON  /Pill / ELB , S PEC , C J , TPREV , HPREV , HCHECK , TCHECK 
COMMON  /A18/  ITNEG , I EXP 
REAL* 8 MUI , MU , MUINF , LAMSQ 
EQUIVALENCE  (CUVAR(2),H) 

C 

IF  (IEXP.NE. 1)  GO  TO  1 
GO  TO  15 

C REDUCE  COMPUTING  INTERVAL  TO  TRY  AND  AVOID  EXP  ERROR  STOP 

1 IF  (ITNEG. EQ.O)  GO  TO  4 

C E.GT.H  SOMETIMES  LEADS  TO  NEG  T- -REDUCE  INTERVAL  TO  TRY  TO  AVOID  INSTABILITY 
GO  TO  15 

4 IMAXP1  - IMAX  + 1 
DO  10  I - 3 , IMAXP1 

C CUVAR(2)  - H MAY  BE  NEGATIVE 

IF  (CUVAR(I) .LT.0.0)  WRITE(*,5)  I , IX, CUVAR(I) 

IF  (CUVAR(I) .LT.0.0)  GO  TO  15 

5 FORMAT ( IX , 'NEG  Cl  AT  I - ' ,13, IX, 'IX  - ' ,13, IX, 'CUVAR(I)  - ' , 

* E12. 5, IX, 'IN  SUB  CHECK'/) 

10  CONTINUE 


IF  (IX.LT.3)  GO  TO  30 

IF  ( (IPSI . EQ.  (NSR+1)  ) .AND.  (IX. LT.  (NSR+3) ) ) GO  TO  30 
IF  (DABS(TPREV  - T)/T . LT . TCHECK)  GO  TO  25 
WRITE(*,11) 

11  FORMAT (IX, 'CHECK  ABS ( TPREV - T ) /T . GE . TCHECKT  IN  SUB  CHECK'/) 

15  IF  (SPEC.GT. l.OE-15)  GO  TO  20 

WRITE (*,*) 'SPEC  .LT.  l.OE-15  IN  SUB  CHECK  STOP  30' 

STOP 

C STOP  30 

C REDUCE  INTERVAL 

20  SPEC  - SPEC/4.0 
CJ  - SPEC 
ELB  - 1.0 

WRITE (*, 22 ) SPEC , IPSI , IX , T , TPREV , H , HPREV , I EXP , ITNEG 
22  FORMAT (IX, 'REDUCED  SPEC  - ' , E9 . 4 , 2X, ' IPSI  - ',I3,2X,'IX  - ',13, 

* 2X,'T  - ' ,E9.4,2X, 'TPREV  - ' , E9 .4,/, IX, 'H  - '.E9.4.3X, 

* 'HPREV  - ' .E9.4.3X, 'I EXP  - ', 13 , 3X, ' ITNEG  - ',13,'  IN  CHECK'/) 

ITNEG  - 0 

I EXP  - 0 
RETURN 

25  IF  (DABS( (HPREV  - H)/H) . GT . HCHECK)  WRITE(*,27) 

27  FORMAT (IX, 'CHECK  ABS( (HPREV-H)/H) .GT.HCHECKT  IN  SUB  CHECK'/) 

IF  (DABS( (HPREV  - H)/H) .GT. HCHECK)  GO  TO  15 
C ACCEPTABLE 

30  TPREV  - T 
HPREV  - H 
ELB  - 0.0 
RETURN 
END 
C 

C 

c 

SUBROUTINE  SHOCKG  (NXPSTM1 , ITK) 

C 

C SUBROUTINE  SHOCKG  CALLED  BY  MAIN  AND  MUST  BE  SUPPLIED  BY  USER. 

C X,ZS,RS,RC, COST, SINT  FOR  EACH  X FROM  0.0  TO  X AT  ZSTERM  IN  INCREMENTS 
C OF  (DELX/NSR)  TO  DELX  AND  INCREMENTS  OF  DELX  THEREAFTER. 

C 

C X - DISTANCE  ALONG  SHOCK 

C ZS  DISTANCE  ALONG  SHOCK  AXIS  OF  SYMMETRY 

C RS  - RADIUS  OF  SHOCK 

C RC  - RADIUS  OF  CURVATURE  OF  SHOCK 

C COST  - COS  OF  ANGLE  OF  ATTACK 

C SINT  - SIN  OF  ANGLE  OF  ATTACK 

C 

IMPLICIT  REAL*8(A-H,0-Z) 

COMMON  /A9/  EVIS(25) .XPST(IOO) 

COMMON  /A12/  SINTM(200) ,COSTM(200),RSM(200) ,RCM(200) ,X1(200) 

* , ZSM(200) 

COMMON  /A13/  DELX, ZSTERM, IZTERM.NSR, MW, SP.TS 

DIMENSION  ZDUM(501) ,RSDUM(501) ,RCDUM(501) ,XC(501) , CODUM(SOl) , 

* SIDUM(501) 

C Rs/L  - SQRT ( 2*R*Zs /L  - Bs*(Zs/L)**2)  WHERE:  L - 1.0  cm 

ITK  = 0 
EL  - 1.0 
R - 230.0 
BS  - -4.0 
DO  5 I - 2,501 

5 ZDUM(I)  - (I-l)*ZSTERM/500 
ZDUM(l)  - 0.0 

WM 


RSDUM(l)  - 0.0 
XC(1)  - 0.0 
CODUM(l)  - 0.0 
SIDUM(l)  - 1.0 
RCDUM(l)  - 230.0 

DO  10  I - 2,501 
ZSND  - ZDUM ( I ) /EL 

RSDUM(I)  - DSQRT ( 2 . *R*ZSND  - BS*ZSND**2) 

C - 1 . 0/(R  - BS*ZSND)**2 

Cl  - DSQRT ( C*RSDUM ( I ) **2  + 1.0) 

XC(I)  - RSDUM(I)/2.*C1  + 1 . / ( 2 . *DSQRT ( C) ) *DLOG (RSDUM ( I ) *DSQRT ( C ) 

* + Cl) 

D1  - (R  - BS*ZSND)/RSDUM(I) 

D2  - - (R  - BS*ZSND)**2/RSDUM(I)**3  - BS/RSDUM(I) 

THETA  - ATAN(Dl) 

SIDUM(I)  - DSIN (THETA) 

CODUH(I)  - DCOS (THETA) 

RCDUM(I)  - (1.0  + Dl**2)**l. 5/DABS (D2) 

DIMENS IONALIZED  QUANTITIES 

RCDUM(I)  - EL*RCDUM ( I ) 

XC(I)  - EL*XC ( I ) 

RSDUM(I)  - EL*RSDUM(I) 

CONTINUE 

WRITE(*, 25) 

WRITE(8 , 25) 

FORMAT ( 5X , 'X' ,11X, 'ZS' ,10X, 'RS' ,10X, 'RC' ,9X, 'COST' ,8X, 'SINT'/) 

NOX  - 0 
M ■»  1 
NZS  - 501 

INTERPOLATE  SHOCK  VALUES  TO  X SHOCK  COORDINATE 

NOX  - NOX  + 1 

IF  (NOX.LT. (NSR+2) ) X - X + DELX/NSR 
IF  (NOX. EQ . 1)  X - 0.0 
IF  (NOX.GT. (NSR+1))  X - X + DELX 
CALL  FTLUP  (X , ZS , M, NZS ,XC, ZDUM) 

CALL  FTLUP  (X,RS ,M, NZS ,XC, RSDUM) 

CALL  FTLUP  (X,RC,M,NZS ,XC,RCDUM) 

CALL  FTLUP  (X, COST ,M, NZS ,XC , CODUM) 

CALL  FTLUP  (X.SINT.M.NZS ,XC, SIDUM) 

WRITE (8,35)  X , ZS  , RS , RC , COST , SINT , NOX 
WRITE(*,35)  X,ZS,RS,RC, COST, SINT, NOX 
F0RMAT(1X,6(E10.4,2X) ,14) 

SINTM(NOX)  - SINT 
COSTM(NOX)  - COST 
RSM(NOX)  - RS 
R CM (NOX)  - RC 
XI (NOX)  - X 
ZSM(NOX)  - ZS 
DO  36  IT  - 2.NXPSTM1 

IF  (DABS(XPST(IT)  - X) . GT. 1 . 0E-06)  GO  TO  36 

ITK  - ITK  + 1 

CONTINUE 

IF  (ZS.GE.0.0)  GO  TO  40 
WRITE(*,37)  ZS 

FORMAT (IX,  ' ZS  SHOULD  BE  GREATER  THAN  0.0  : ZS  - \E10.5, 

* /,1X, 'STOP  13'/) 

STOP 


STOP  13 


oooo  oooooooo 


40 


IF  (ZS.LT.ZSTERM)  GO  TO  30 

IZTERM  - NOX 

RETURN 

END 


SUBROUTINE  CALINTH  (N.CIMAX.PHMAX) 

IN  THE  CALINTH  VERSION  OF  CALINT,  THE  VARIABLE  IN  VAR(2)  AND 
CUVAR(2)  MAY  BE  + OR  VALUES  OF  OTHER  DEPENDENT  VARIABLES 
ARE  EXPECTED  TO  BE  POSITIVE.  10-69 

IMPLICIT  REAL*8 (A-H , 0- Z) 

COMMON  /Al/  M , IX , IMAX , I PS I , MODEL , TE1 , TE2 
COMMON  /A2/  P(200) ,DPDX(200) ,VARI(200) 

COMMON  /A3/  EVIINF(25) ,THETAI(25) ,MUI(25) ,FI(25) ,DELHI(25) , 

* CIINF(25) ,LI(25) 

COMMON  /A4/  R , MUINF , DELTA , LAMSQ , OMEGSQ , OMEGA , MU , T , U , TINF 
COMMON  /A5/  EPSIIL(20 , 25) ,GIL(20,25) ,CID(200,4) 

COMMON  /A6/  VAR(52) ,CUVAR(52) ,DER(51) 

COMMON  /A7/  MJ(50) ,EJ(50) ,AJ(50) ,BJ(50) .DIRECT (50) 

COMMON  /A8/  TVI(25) ,NI(25) ,DGENI(25) , BI ( 25 ) 

COMMON  /A10/  NUIJ (26,50) , AIJ (25,50) ,NUPIJ (25 ,50) 

COMMON  /All/  SIGIK(25,25)  , ALPIK(25 , 25) , BETAIK(25 ,25) 

COMMON  /A17/  ELB , SPEC , CJ , TPREV ,HPREV , HCHECK, TCHECK 
COMMON  /A19/  ELE1(51) ,ELE2(51) ,NERR 
REAL* 8 MUI, MU, MUINF, LAMSQ 

DIMENSION  Fl(51) ,F2(51) ,F3(51) ,CAPF1(51) ,CAPF2(51) ,CAPF3(51) 

* ,P1(51) ,PH(51) ,DELTY(51) ,Y3(51) ,Y4(51) ,F4(51) ,Y2(51) 

IF  CJ  OR  N IS  EQUAL  TO  ZERO  : NERR  - 1 

IF  ELE1  IS  LESS  THAN  OR  EQUAL  TO  ELE2  : NERR  - 2 

TEST  INPUT 

FN  - N 

TEST  - CJ*FN 
IF  (TEST)  998,997,998 

997  NERR  - 1 
RETURN 

998  DO  999  I - 1,N 

IF  ( (ELE1 ( I ) - ELE2 (I)) .LE.0.0)  THEN 
NERR  - 2 
RETURN 
ENDIF 

999  CONTINUE 

1000  IF  (SPEC)  5,1,5 

C SECTION  FOR  INITIALIZATION  COMPUTATION  OF  DERIVATIVES 

1 SPEC  - CJ 
ICONT  - 1 

2 N1  - N + 1 

DO  3 I - 1,N1 

3 CUVAR(I)  - VAR(I) 

CALL  BASIC 

C RETURN  WITH  DERIVATIVES  IN  DER 

DO  4 I - 1,N 

4 FI (I)  - DER(I) 

RETURN 

5 CUVAR(l)  - VAR(l)  + CJ/2.0 
DO  6 I - 1,N 


C 


COMPUTE  Y2,X2 


II  - I + 1 

Y2(I)  - VAR(Il)  + CJ/2.0*F1(I) 

IF  (I.EQ.l)  GO  TO  6 
IF  (Y2(I))  65,6,6 

6 CUVAR(Il)  - Y2(I) 

GO  TO  66 

65  SPEC  - CJ 
CJ  - CJ/2.0 
GO  TO  5 

C CALL  BASIC  TO  EVALUATE  F2 

66  CALL  BASIC 

c RETURN 

DO  7 I - l.N 
II  - I + 1 
F2(I)  - DER(I) 

c COMPUTE  Y3 

Y3(I)  - VAR(Il)  + CJ/2.0*F2(I) 

IF  (I.EQ.l)  GO  TO  7 
IF  (Y3(I))  65,7.7 

7 CUVAR(Il)  - Y3(I) 

C CALL  BASIC  TO  EVALUATE  F3 

CALL  BASIC 

C RETURN 

DO  10  I - l.N 
F3(I)  - DER(I) 

C COMPUTE  P, PH  AND  CAP  F TERMS 

IF  (Y3(I)  - Y2(I) ) 9,8,9 

8 P1(I)  - 0.0 
GO  TO  91 

9 P1(I)  - - ( (F3(I)  - F2(I) )/(Y3(I)  - Y2(I))) 

91  PH(I)  - P1(I)*CJ 

IF  (PH(I) ) 83,83,103 

83  PH(I)  - 0.0 
P1(I)  - 0.0 
GO  TO  84 

103  Z1  - DABS(Y3(I)  - Y2 (I) )/( (DABS (Y3 (I) ) + DABS (Y2 (I) ) )/2 . 0) 

IF  (Z1  - 0.5E-04)  83,83,84 

84  IF  (PH(I)  - 0.1)  85,85,95 

85  CAPFl(I)  - 1.0  - PH(I)/2 . 0 + PH(I)**2/6 . 0 - PH(I)**3/24 . 0 
CAPF2 (I)  - 0.5  - PH(I)/6 . 0 + PH(I)**2/24 . 0 - PH(I)**3/120.0 
CAPF3(I)  - 1./6.-  PH(I)/24.  + PH(I)**2/120 . - PH(I)**3/720 . 

GO  TO  10 

95  CAPFl(I)  - ( DEXP ( - PH ( I ) ) - 1.0)/(-  PH(I)) 

CAPF2(I)  - (CAPFl(I)  - 1.0)/(-  PH ( I ) ) 

CAPF3 ( I ) - (CAPF2 (I)  - 0.5)/(-  PH(I)) 

10  CONTINUE 

C IS  PH  BETWEEN  ELE2  AND  ELE1 

IF  (ICONT  - 1)  101,101,102 

102  ICONT  - ICONT  - 1 
SPEC  - CJ 
GO  TO  17 

101  DO  11  I - 1,N 

IF  (DABS(PH(I) ) - ELE1 (I) ) 11,11,13 

11  CONTINUE 
SPEC  - CJ 
GO  TO  15 

C HALVE  INTERVAL  AND  DOUBLE  PH  RANGE 

13  DO  96  I - l.N 

ELE1(I)  - ELE1(I)*2.0 
IF  (ELEl(I)  - PHMAX)  94,94,955 


L)ll 
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94  ELE2 ( I ) - ELE2(I)*2.0 
GO  TO  96 

955  ELE1(I)  - ELEl(I)/2.0 
96  CONTINUE 
SPEC  - CJ 
CJ  - CJ/2.0 
ICONT  - 3 
GO  TO  5 


C 

15 

16 
C 


165 

C 

17 


175 


18 


C 


RETURN  TO  RECOMPUTE  INTERVAL 

DO  16  I - l.N 

IF  (DABS(PH(I) ) - ELE2 ( I ) ) 16,17,17 
CONTINUE 

DOUBLE  INTERVAL 

CJ  - 2 . 0*CJ 

IF  (CJ  - CIMAX)  17,17,165 
CJ  - CIMAX 

COMPUTE  Y4.X4 

DO  18  I - 1 ,N 
II  - I + 1 

CUVAR(Il)  - VAR (II)  + S PEC* ( F3 ( I ) * ( 2 . 0*CAPF2 ( I ) ) + F1(I)* 

* (CAPFl(I)  - 2 . 0*CAPF2(I) ) + F2(I)*PH(I)*CAPF2(I) ) 

IF  (I.EQ.l)  GO  TO  18 
IF  (CUVAR(Il))  175,18,18 
CJ  - SPEC 
CJ  - CJ/2.0 
GO  TO  5 

Y4(I)  - CUVAR(Il) 

CUVAR(l)  - VAR(l)  + SPEC 

CALL  BASIC  TO  EVALUATE  F4 


CALL  BASIC 
C 


RETURN 


DO  20  I - l.N 
II  - I + 1 
F4(I)  - DER(I) 

COMPUTE  DELTA  Y 


DELTY(I)  - SPEC*(Fl(I)*CAPFl(I)+( -3 . 0*(F1(I)+P1 (I)*VAR(I1) )+2 . 0* 

* ( F2 ( I ) +P1 ( I ) *Y2 ( I ) ) + 2 . 0*(F3 (I)+P1 (I)*Y3(I) ) - F4(I)  - P1(I)* 

* Y4 ( I ) ) *CAPF2 ( I ) + 4 . 0*( (F1(I)+P1(I)*VAR(I1) ) - (F2(I)+P1(I)* 

* Y2 ( I ) ) - (F3 (I)+P1(I)*Y3 (I) ) + (F4(I)+P1(I)*Y4(I) ) )*CAPF3 (I) ) 

C 

C COMPUTE  Y + DELTA  Y 

20  CUVAR(Il)  - VAR(Il)  + DELTY(I) 

C CALL  CHECK  FOR  DECISION  TO  ACCEPT  OR  RECOMPUTE  INTERVAL 

CALL  CHECK 
IF  (ELB)  21,21,23 

C UPDATE  Y VALUES 

21  N1  - N + 1 

DO  22  I - 2, N1 
II  - I - 1 

22  VAR(I)  - VAR(I)  + DELTY(Il) 

VAR(l)  - VAR(l)  + SPEC 

C RETURN  TO  COMPUTE  DERIVATIVES  AT  Y + DELTA  Y 

GO  TO  2 

C RETURN  TO  RECOMPUTE  INTERVAL 

23  GO  TO  5 
END 

C 

C 

c 


Lp3 
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SUBROUTINE  FTLUP  (X.Y.M.N.VARI ,VARD) 


THIS  SUBROUTINE  IS  A MODIFICATION  OF  LIBRARY  INTERPOLATION 
SUBROUTINE  FTLUP  REVISED  7-7-69 

IMPLICIT  REAL*8(A-H,0-Z) 

DIMENSION  VARI(l) ,VARD(1) ,V(3) ,YY(2) ,11(100) 

INITIALIZE  ALL  INTERVAL  POINTERS  TO  -1.0  FOR  MONOTONICITY  CHECK 
DO  4 J - 1,100 

4 II(J)  - -1 
MA  - IABS(M) 

ASSIGN  INTERVAL  POINTER  FOR  GIVEN  VARI  TABLE  ; THE  SAME  POINTER 
WILL  BE  USED  ON  A GIVEN  VARI  TABLE  EVERY  TIME 

LOCF  - VARI ( 1 ) 

LI  - MOD(LOCF.IOO)  + 1 
I - II(LI) 

IF  (I.GE.O)  GO  TO  10 
IF  (N.LT.2)  GO  TO  10 
C MONOTONICITY  CHECK 

IF  (VARI (2)  - VARI(l) ) 1,1,3 

C ERROR  IN  MONOTONICITY 

2 K - LOCF 
WRITE(*,102)  J,K 

102  FORMAT (IX, 'TABLE  BELOW  OUT  OF  ORDER  FOR  FTLUP  AT  POSITION  ', 

* 15 ,//, IX, 'X  TABLE  IS  STORED  IN  LOCATION' , 15//) 

DO  103  J - 1,N 

103  WRITE(*,*)  VARI(J) ,VARD(J) 

STOP 

c MONOTONIC  DECREASING 

1 DO  5 J - 2,N 

IF  (VARI (J)  - VARI(J-l))  5,2,2 

5 CONTINUE 
GO  TO  10 

C MONOTONIC  INCREASING 

3 DO  6 J - 2,N 

IF  (VARI (J)  - VARI ( J - 1 ) ) 2,2,6 

6 CONTINUE 

C INTERPOLATION 

10  IF  (I.LE.O)  I - 1 

IF  (I.GE.N)  I - N - 1 
IF  (N.LE.l)  GO  TO  8 
IF  (MA. NE . 0)  GO  TO  99 

C ZERO  ORDER 

8 Y - VARD(l) 

GO  TO  800 

C LOCATE  I INTERVAL  (X(I) ,LE.X.LT.X(I+1) ) 

99  IF  ( (VARI (I)  - X) * (VARI ( 1+1 ) - X))  61,61,40 
C IN  GIVES  DIRECTION  FOR  SEARCH  INTERVALS 

40  SIGN1  - 1.0 

IN  - SIGN(SIGN1,  (VARKI+l)  - VARI(I))*(X  - VARI(I))) 

C IF  X OUTSIDE  ENDPOINTS,  EXTRAPOLATE  FROM  END  INTERVAL 

41  IF  ( (I+IN) . LE. 0)  GO  TO  61 
IF  ((I+IN) .GE.N)  GO  TO  61 
I - I + IN 

IF  ((VARI (I)  - X)*(VARI(I+1)  - X))  61,61,41 
61  IF  (MA.EQ.2)  GO  TO  200 

C FIRST  ORDER 

Y - (VARD( I)* (VARId+1)  - X)  - VARD(I+1)*(VARI(I)  - X))/ 

* (VARI ( 1+1)  - VARI ( I ) ) 

GO  TO  800 


o o o o o 


SECOND  ORDER 


200  IF  (N.EQ.2)  GO  TO  2 

IF  (I.EQ. (N-l) ) GO  TO  209 
IF  (I.EQ. 1)  GO  TO  201 

C PICK  THIRD  POINT 

SK  - VARI ( 1+1 ) - VARI(I) 

IF  ( (SK*(X  - VARI  (I- 1)  ) ) .LT.  (SK*  (VARI  (1+2)  - X)))  GO  TO  209 

201  L - I 

GO  TO  702 
209  L - I - 1 
702  V(l)  - VARI (L)  - X 
V(2)  - VARI (L+l)  - X 
V(3)  - VARI (L+2)  - X 

YY(1)  - (VARD(L)*V(2)  -VARD(L+1)*V(1)  )/ (VARI  (L+l)  - VARI  (L)  ) 
YY(2)  - (VARD(L+1)*V(3)  -VARD(L+2)*V(2)  )/(VARI  (L+2)  -VARI  (L+l)  ) 
Y - (YY(1)*V(3)  - YY(2)*V(1))/ (VARI ( L+2 ) - VARI(L)) 

800  II (LI)  - I 
RETURN 
END 


SUBROUTINE  FOFTS23  (MAXI , TOL1 , TOL2 , ICODE , TSG , IQ1 , IQ2 , IQ3 ) 

CALLED  BY  MAIN  TO  EVALUATE  TS  BY  NEWTON  ITERATION  TECHNIQUE 
C 

IMPLICIT  REAL*8(A-H,0-Z) 

COMMON  /Al/  M , IX , IMAX , IPSI , MODEL , TE1 , TE2 
COMMON  /A2/  P(200) ,DPDX(200) ,VARI(200) 

COMMON  /A3/  EVIINF(25) ,THETAI(25) ,MUI(25) ,FI(25) ,DELHI(25) , 
* CIINF(25) ,LI(25) 

COMMON  /A4/  R ,MUINF, DELTA , LAMSQ , OMEGSQ , OMEGA, MU, T,U,TINF 
COMMON  /A5/  EPSIIL(20 , 25) , GIL(20 , 25) , CID(200 ,4) 

COMMON  /A6/  VAR(52) ,CUVAR(52) ,DER(51) 

DIMENSION  SUMGM(25) ,EISM(25) ,DEISM(25) 

REAL* 8 MUI, LAMSQ, MUINF, MU 
C 

W - 1.0 

DO  1 I - 1 , IMAX 

1 CID(IX, I)  - CIINF(I) 

ITER  - 0 

2 ITER  - ITER  + 1. 

IF  (ITER. EQ . 1)  THEN 
ES  - DELTA 

PS  - DSQRT (OMEGSQ  - 2 . *LAMSQ* (DELTA  - ES)) 

END  IF 

IF  (IQ1.EQ.1)  THEN 
TVIB  - TINF 
ELSE 

TVIB  - TSG 
END  IF 

IF  (IQ2.EQ.1)  THEN 
TEL  - TINF 
ELSE 

TEL  - TSG 
END  IF 
C 

ES  - 0.0 

DES  - 0.0 

DO  25  I - 1 , IMAX 
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IF  (M.EQ.l)  EVIS  - EVIINF(I) 

IF  (M.EQ.l)  GO  TO  5 

TEM  - DEXP ( THETAI ( I ) /TVIB ) 

EVIS  - (R*THETAI(I))/(MUI(I)*(TEM  - 1.0))*FI(I) 

DEVIS  - (R*FI(I)*THETAI(I)**2)/(MUI(I)*TVIB**2)*(TEM/(TEM-1.0)**2) 

5 IF  (I.EQ.l)  QVN  - 1.0/(1.0  - DEXP( -THETAI (I)/TVIB) ) 

IF  (I.EQ.2)  QVO  - 1.0/(1.0  - DEXP( -THETAI (I)/TVIB)) 

SUMGM(I)  - 0.0 
SUMGE  - 0.0 
DSUMGE  - 0.0 
LI  I - LI  (I) 

C 

DO  10  L - l.LII 

TEM1  - DEXP(-EPSIIL(L, I)/TEL) 

SUMGM(I)  - SUMGM(I)  + TEM1*GIL(L, I) 

SUMGE  - SUMGE  + TEM1*GIL(L, I)*EPSIIL(L,  I) 

10  DSUMGE  - DSUMGE  + TEMl*GIL(L, I)*EPSIIL(L, I)**2 
QROTN  - TSG/5.8 
QROTO  - TSG/4.2 

EEIS  - (R/MUI (I) )*(SUMGE/SUMGM(I) ) 

DEEIS  - R/MUI (I)*( ( (SUMGM(I)*DSUMGE/TEL**2)  - (SUMGE/TEL)**2) 

* /SUMGM(I)**2) 

EISM(I)  - (1 . 5*R*TSG)/MUI (I)  + (FI(I)*R*TSG)/MUI(I)  + EVIS  + EEIS 

* + DELHI ( I ) /MUI ( I ) 

DEISM(I)  - 1.5*R/MUI(I)  + FI(I)*R/MUI(I)  + DEVIS  + DEEIS 
25  CONTINUE 

C BETA  FOR  OXYGEN 

IF  (IQ3.EQ.2)  THEN 
TD  - 59500.0 

FI  - CIINF(2)*MUINF/MUI(2) 

CIA  - TD/TSG  ' 

CIA  - DEXP(ClA/2 . 0) 

C1B  - 8 . 8568195*(1 . - CIINF(l) )*C1A*(1 . /(TSG**2 . 5)  ) 

Cl  - C1A*2.0*MUINF*PS*C1B*QVO*QROTO*(SUMGM(2)/(SUMGM(4)**2))/R 
BETAO  - ( (Fl-1 . ) + DSQRT ( (1 . -Fl)**2  + 4 ,*(F1+C1) ) )/(2 . *(F1+C1) ) 

BETAN  - 0.0 
END  IF 

C BETA  FOR  NITROGEN  AND  OXYGEN 

IF  (IQ3.EQ.3)  THEN 
BETAN  - .1 
BETAO  - 1.0 
TDN  - 113500.0 
TDO  - 59500.0 

FlA  - 8 . 8568195*(1.  - CIINF(l) )*DEXP(TDO/TSG)*(l./(TSG**2 . 5) ) 

F2A  - 12 . 36681*(1 . - CIINF(2) )*DEXP(TDN/TSG)*(1 . /(TSG**2 . 5) ) 

FI  - 2.0*MUINF*PS*F1A*QV0*QR0T0*(SUMGM(2)/(SUMGM(4)**2))/R 
F2  - 2 . 0*MUINF*PS*F2A*QVN*QR0TN*(SUMGM(1)/(SUMGM(3)**2) )/R 
30  A - ((1.  - BETAO**2)  + BETAN* (1 . - BETAO) )/ (BETAO** 2)  - FI 
B - ((1.  - BETAN**2)  + BETAO*(l.  - BETAN) )/(BETAN**2)  - F2 
ABO  - (BETAN*BETAO  - 2.*(1.  + BETAN) )/(BETAO**3) 

ABN  - (1.  - BETAO) /(BETAO**2) 

BBO  - (1.  - BETAN) /(BETAN**2) 

BBN  - ( BETAN*BETAO  - 2.*(1.  + BETAO) )/(BETAN**3) 

DEN  - ABO*BBN  - BBO*ABN 
DBO  - ( -A*BBN  + B*ABN) /DEN 
DBN  - ( - B*ABO  + A*BBO)/DEN 
BETAN  - BETAN  + DBN 
BETAO  - BETAO  + DBO 

IF  ((DABS(DBO) .GT. .00001) .OR. (DABS(DBN) .GT. .00001))  GO  TO  30 
END  IF 


c DISSOCIATING  CONCENTRATIONS  ACROSS  THE  SHOCK 

CID(IX, 2)  - (1.0  - BETAO)*CIINF(2) 

CID(IX,4)  - BETAO*CIINF(2) 

CID(IX.l)  - (1.0  - BETAN)*CIINF(1) 

CID(IX, 3)  - BETAN*CIINF(1) 

C 

DO  35  I - l.IHAX 

ES  - ES  + EISM(I)*CID(IX, I) 

35  DES  - DES  + DEISM(I)*CID(IX, I) 

FAC  - DSQRT(OMEGSQ  - 2 . 0*LAMSQ*( DELTA  - ES)) 

FIN  - (2 . 0*MUINF*( DELTA  - ES)*FAC)/(R*(OMEGA  + FAC)) 

FTS  - TSG  - FIN 

FAC1  - R*  ( OMEGA+FAC ) * (MUINF*  (DELTA - ES  ) * ( 2 . 0/FAC ) *LAMSQ*DES  - 
* 2 . 0*FAC*MUINF*DES  ) - 2 . 0*MUINF*( DELTA -ES)*R*LAMSQ*DES 

FAC 2 - R**2* (OMEGA  + FAC)**2 
DFTS  - 1.0  - (FAC1/FAC2) 

PS  - FAC 

IF  (DFTS. EQ. 0.0)  THEN 
ICODE  - 2 
RETURN 
END  IF 

TSG1  - TSG  - W*(FTS/DFTS) 

DELTS  - DABS(TSG1  • TSG) 

TSG  - TSG1 

IF  (ITER. GE. MAXI)  THEN 
ICODE  - 1 
RETURN 
END IF • 

IF  ( DELTS. GT.T0L1)  THEN 
ITER1  - ITER 
GO  TO  2 
END  IF 

ITER2  - ITER1  + 10 

IF  ( DELTS. LE.TOL2. OR. ITER. GE.ITER2)  RETURN 

GO  TO  2 

END 
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c PROGRAM  FOR  COMPUTING  THE  RADIATIVE  HEAT  TRANSFER  AT  THE  BODY  SURFACE 
C IN  A HYPERSONIC  FLOWFIELD . THIS  PROGRAM  IS  USED  IN  CONJUNCTION  WITH 
C AFE2 . FOR 
C 

C RADIATION  MODELS  1)  OLSTAD  MODEL 

C 2)  CARLSON  MODEL 

C 

IMPLICIT  REAL*8(A-H,0-Z) 

COMMON  /A9/  MUI(25) ,XPST(30) 

COMMON  /RAD/  NXCON ,NPTS (30) , TSTAG , LI (25) , IMAX 
COMMON  /RADI/  RRHO(30, 30) ,Y(30, 30) ,YBDY(30) 

COMMON  /RAD2/  RCON(30 , 10 , 30) 

COMMON  /RAD3/  B(30,8,30) 

COMMON  /RAD5/  OPTL(30, 8 , 30) 

COMMON  /RAD6/  ALPN(30 , 30) , ALPO(30 , 30) , BETN(30 , 30) , BETO(30 , 30) 

COMMON  /RAD7/  TEMP0(30 , 30) ,TEMP(30 , 30) 

COMMON  /RAD8/  KAP(30,4,30) 

COMMON  /RAD9/  KAPPA(30 , 8 , 30) ,KA(30 ,4 , 30) 

COMMON  /RADIO/  EPSIIL(20 , 25) , GIL(20 , 25) 

C REAL  OPTL.XPST.Y.YBDY, TEMPO, TEMP, Z 
C REAL  ALPN , ALPO , B , BETN , BETO 

REAL* 8 KAPPA, KAP, KA.MUI.EPS I IL, GIL 
CHARACTER* 30  OUTFIL 

C OPEN  RADIATION  INPUT  FILES  (AFE2 . FOR) 

OPEN  (UNIT-15  , FILE- ' RADIN1 . DAT ' , STATUS- ' OLD ' ) 

OPEN  (UNIT-16  , FILE- ' RADIN2 . DAT ' , STATUS- ' OLD ' ) 

OPEN  (UNIT-17, FILE- 'RADIN3.DAT' , STATUS-' OLD ' ) 

C READ  INPUT 

READ(15 , 1)  OUTFIL 

1 FORMAT (A30) 

READ ( 15 , *)  MODEL, IQ3 , VINF , TINF , PINF 
READ ( 15 , *)  NXPST , NXCON , IMAX , IQ4 , IQS , IQ6 , IQ8 , IQ9 
IF  (NXCON. GT. 30)  THEN 
WRITE(* ,2)  NXCON 

2 FORMAT (IX, 'NXCON  - ',13,'  MAX  - 30  STRLNES  IN  RAD. FOR') 

STOP 

ENDIF 

IF  (IQ4.EQ.0)  GO  TO  60 

OPEN  (UNIT-8  , FILE-OUTFIL , STATUS- ' UNKNOWN ' ) 

DO  5 I - 1 , IMAX 
5 READ (15 ,*)  MUI(I) 

DO  7 I - 1 , IMAX 
READ (15 , *)  LI I 
LI  (I)  - LI  I 

7 READ (15 , *)  (GIL(L, I) , L - l.LII) 

DO  9 I - 1 , IMAX 
READ (15,*)  LI I 

9 READ (15 , *)  (EPSIIL(L.I) ,L  - l.LII) 

DO  10  I - 1, NXPST 
10  READ (15 , *)  NPTS(I) ,XPST(I) 

READ (15,*)  TSTAG 
READ (15,*)  KSTAG 
DO  15  I - 1, KSTAG 
READ (16,*)  LPS2 , JJJ 
IF  (IMAX.EQ.7)  THEN 

READ (16 ,*)  RCON(LPS2 , 1 , JJJ) ,RCON(LPS2 , 2 , JJJ) ,RCON(LPS2 , 3 , JJJ) , 

* RCON(LPS2 , 4 , JJJ) , RCON(LPS2 , 5 , JJJ) ,RCON(LPS2 , 6 , JJJ) , 

* RCON(LPS2 , 7 , JJJ) , RRHO(LPS2 , JJJ) , TEMP(LPS2 , JJJ) , 

* TEMPO(LPS2 , JJJ) 


ENDIF 


IF  (IMAX.EQ.10)  THEN 

READ(16 ,*)  RCON(LPS2 , 1 , JJJ) ,RCON(LPS2 , 2 , JJJ) ,RCON(LPS2 , 3 , JJJ) , 

* RCON(LPS2,4, JJJ) , RCON(LPS2 , 5 , JJJ) ,RCON(LPS2 , 6 , JJJ) , 

* RCON (LPS2,7,JJJ) , RCON ( LPS  2 . 8 , J J J ) , RCON ( LPS  2 , 9 , J J J ) , 

* RCON(LPS2 , 10 , JJJ) ,RRHO(LPS2 , JJJ) ,TEMP(LPS2 , JJJ) , 

* TEMPO (LPS2, JJJ) 

ENDIF 

15  CONTINUE 

19  READ(17,*, END-21)  IBOB.IK 
READ(17 ,*)  YBDY(IBOB) 

DO  20  J - 2, IK 

20  READ(17 ,*)  Y(IBOB, J-l) 

GO  TO  19 

INITIAL  CONDITIONS 

21  WRITE(* , 22)  VINF , PINF , TINF 
WRITE(8 , 22)  VINF, PINF, TINF 

22  FORMAT ( IX, 'FREESTREAM  QUANTITIES  : ' ,//,lX, 'VINF  - ',E12.5,1X, 

* 'cm/sec' ,/, IX, ’PINF  - ' , E12 . 5 , IX, ' dynes/cmA2 ' ,/ , IX, 

* 'TINF  - ' .E12.5.1X, 'K'///) 

WRITE (*,23)  MODEL 

WRITE (8, 23)  MODEL 

23  F0RMAT(1X, 'VIBRATION-DISSOCIATION  COUPLING  MODELS ',//, 12X, 

* 'TYPE' ,11X, 'NO. ' ,//,9X, 'VIB.  EQUIL. ' , 8X, ' 0’ ,/, 12X,  ' CVD' . 13X, 

* '1' , /, 12X, ' CVDV' , 12X, '2' ,/,6X, 'CVDV- Preferential' ,5X, '3' ,/, 

* 12X, 'PARK' ,12X, '4' , ' -’,13///) 

WRITE(*,24)  IQ3 

WRITE(8 , 24)  IQ3 

24  FORMAT (7X, 'SHOCK  JUMP  CONDITION  MODELS ',//, 12X, 

* 'TYPE' ,11X, 'NO. ' ,//,6X, 'CHEMISTRY  FROZEN' , 6X, ' 1' ,/, 5X, 

* 'N2  FROZEN,  02  DISS . ' ,4X, ' 2' ,/,7X, 'N2  AND  02  DISS.',6X, 

* '3','  - ' ,13///) 

RADIATION  MODELS 

IF  (IQ4.EQ.1)  CALL  OLRAD  (IQ5 , IQ6 , IQ8 , IQ9) 

IF  (IQ4.EQ.2)  CALL  CARLRAD  (IQ4 , IQ5 , IQ9) 

IF  ((IQ4.EQ.3) .OR. (IQ4.EQ.4))  THEN 
CALL  OLRAD  (IQS , IQ6 , IQ8 , IQ9) 

CALL  CARLRAD  (IQ4 , IQ5 , IQ9) 

ENDIF 

IF  (IQ4.EQ.4)  THEN 
DO  40  K - 3.NXC0N 
WRITE(*,30)  XPST(K) 

WRITE(8 , 30)  XPST(K) 

30  FORMAT (///, 'AT  X -' ,D11.4,///) 

DO  40  J - 1 ,NPTS(K) 

WRITE(*,35)  J ,TEMP(K, J) ,RRHO(K, J) 

WRITE(8 , 35)  J,TEMP(K,J) ,RRHO(K,J) 

35  FORMAT ( ' J - ',12,'  TVN2  - '.Dll. 4,'  RHO  - \D11.4) 

40  CONTINUE 

DO  55  K - 3.NXCON 
WRITE(* , 30)  XPST(K) 

WRITE(8 , 30)  XPST(K) 

DO  55  J - 1,NPTS(K) 

WRITE(*,45)  J 
WRITE(8 ,45)  J 

45  FORMAT ( / , ' AT  J - ',12,'  THE  NUMBER  DENSITIES  ARE  ' ,/) 

DO  55  I - l.IMAX 
WRITE(8 , 50)  I ,RCON(K, I , J) 

WRITE(* , 50)  I ,RCON(K, I , J) 

50  FORMAT  ( ' SPECIES  - ',12,'  N - \D11.4) 

55  CONTINUE 
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ENDIF 
CL0SE(8) 
60  CLOSE (15) 
CLOSE(16) 
CLOSE(17) 
STOP 
END 


SUBROUTINE  OLRAD  (IQS , IQ6 , IQ8 , IQ9) 

IMPLICIT  REAL*8(A-H,0-Z) 

COMMON  /A9/  MUI(25) ,XPST(30) 

COMMON  /RAD/  NXCON.NPTS(30) ,TSTAG,LI(25) , IMAX 
COMMON  /RADI/  RRHO(30 , 30) , Y(30 , 30) , YBDY(30) 

COMMON  /RAD2/  RCON(30 , 10 , 30) 

COMMON  /RAD3/  B(30,8,30) 

COMMON  /RAD5/  OPTL(30 , 8 , 30) 

COMMON  /RAD6/  ALPN(30 , 30) , ALPO(30 , 30) , BETN(30 , 30) , BETO(30 , 30) 

COMMON  /RAD7/  TEMPO(30 , 30) ,TEMP(30 , 30) 

COMMON  /RAD8/  KAP(30,4,30) 

COMMON  /RAD9/  KAPPA(30 , 8 , 30) ,KA(30,4,30) 

COMMON  /RADIO/  EPSIIL(20 , 25) , GIL(20 , 25) 

REAL  OPTL,XPST,Y,YBDY, TEMPO, TEMP, Z 
REAL  ALPN , ALPO , B , BETN , BETO , EPS I IL, GIL 
REAL* 8 K11,K22,N,NN, KAPPA, KAP.KA.MUI 

WRITE(8 , 1) 

1 FORMAT (///'  OLSTAD  RADIATION  MODEL') 

IF(IQ8 . EQ. 0)  THEN 

IF(IQ6.EQ.O)  WRITE(8 , 2) 

IF(IQ6.EQ.l)  WRITE (8 ,3) 

ENDIF 

2 FORMAT (/'  BETA-BETA ( Te) ' ) 

3 FORMAT (/'  BETA-BETA(Tt) ' ) 

C NUMBER  DENSITIES 

DO  12  K-3 , NXCON 
DO  12  J-l.NPTS(K) 

DO  10  II— 1 , IMAX 
XXX-RRHO ( K , J ) *6 . 02 3D+2 3 
XXX-XXX*RCON (K , II , J ) /MU I (II) 

10  RCON(K, II , J)— XXX 
12  CONTINUE 

C NONEQUILIBRIUM  RADIATION  CORRECTION 

IF  (IQ5.EQ.0)  THEN 
DO  122  K-3, NXCON 
DO  122  J— 1,NPTS(K) 

IF( J . EQ . NPTS (K) ) THEN 
ALPN (K , J )— 0 . D+00 
BETN (K , J ) — 0 . D+00 
GO  TO  122 
ENDIF 
Q1-0.D+0 
Q2-0 . D+0 
Q3-0.D+0 

DO  112  III-1,LI(3) 

112  Q1-Q1+GIL(III , 3)*DEXP(-EPSIIL(III , 3)/TEMP(K, J) ) 

DO  113  III-1,LI(9) 

113  Q2-Q2+GIL(III , 9)*DEXP(-EPSIIL(III , 9)/TEMP(K, J) ) 

DO  130  III-l.LI(l) 
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130  Q3-Q3+GIL(III , 1)*DEXP( -EPSIIL(III , 1)/TEMP(K, J) ) 

RHOl— RCON (K , 3 , J)*l .401D+01/6 . 023D+23 
RH02-RC0N(K, 9 , J)*l .401D+01/6 . 023D+23 
RH03-RC0N(K, 1 , J)*2 . 802D+01/6 . 023D+23 
RH04— RH01+RH02+RH0  3 

QVIB-1 . D+0/ ( 1 . D+0 - DEXP (-3.39  D+0  3/TEHP  (K,  J)  ) ) 

QROT-TEMP (K , J ) /5 . 8D+0 

Cl— RH04*2 . 4701D+01*QVIB*QR0T*Q3*DEXP ( 1 . 13 5D+05/TEMP (K , J ) ) 
Cl— C1/(Q1**2*TEMP(K, J)**l .5) 

C2-RH04+8 . 909D+06*Q1*DEXP ( 1 . 6 9D+05/TEMP (K , J ) ) 

C2-C2/ (Q2*TEMP (K , J)**l .5) 

ALPHA-0 . 5 D+0 
BETA-0 . 5 D+0 

132  F-BETA**2*(1. D+0- ALPHA) **2*C1+BETA- 1 . D+0 

FA- - 2 . D+0*BETA**2  * ( 1 . D+0 - ALPHA ) *C 1 
FB-2 . D+O+BETA* ( 1 . D+0 -ALPHA) **2*C1+1 . D+0 
G-ALPHA**2*BETA*C2+ALPHA- 1 . D+0 
GA-2 . D+0*ALPHA*BETA*C2+1 . D+0 
GB— ALPHA**2*C2 
DENOM-FA*GB - FB*GA 
DA- ( - F*GB+G*FB ) /DENOM 
DB— ( -G*FA+F*GA) /DENOM 
ALPHA-ALPHA+DA 
BETA-BETA+DB 

IF((DABS(DA) .GT.l.D-05) .OR. (DABS(DB) .GT.l.D-5))  GO  TO  132 
ALPH-RCON (K, 9 , J)/( RCON ( K , 9 , J ) +RCON ( K , 3 , J ) ) 

BET— (RCON (K, 9 , J)+RCON(K, 3 , J) )/(2 . D+0*RCON(K, 1 , J)+ 

* RCON(K, 9 , J)+RCON(K, 3 , J) ) 

IF(IQ6 . EQ. 1)  GO  TO  1888 

BETN  (K , J ) — ( BET**2/ ( 1 . D+0 - BET ) ) * ( ( 1 . D+0 - BETA) / (BETA**2 ) ) 

* *(  (1 . D+0-ALPH)**2/(l .D+0-ALPHA)**2) 

1888  ALPN (K, J) -BET* ( ALPH**2/ ( 1 . D+0 - ALPH ) ) 

* *((1. D+0- ALPHA) /(BETA*ALPHA**2)) 

122  CONTINUE 

DO  142  K-3.NXCON 
DO  142  J-l.NPTS(K) 

IF(J . EQ.NPTS (K) ) THEN 
ALPO (K , J ) — 0 . D+00 
BETO(K,J)— 0. D+00 
GO  TO  142 
ENDIF 
Q1-0.D+0 
Q2-0 . D+0 
Q 3—0. D+0 

DO  152  III-1,LI(4) 

152  Q1-Q1+GIL(III,4)*EXP(-EPSIIL(III,4)/TEMP(K,J)) 

DO  153  III— 1,LI(10) 

153  Q2-Q2+GIL(III,10)*DEXP(-EPSIIL(III,10)/TEMP(K,J)) 

DO  160  III— 1 , LI (2) 

160  Q3— Q3+GIL(III , 2)*DEXP( -EPSIIL(III , 2)/TEMP(K, J) ) 

RHOl-RCON (K , 4 , J ) *1 . 600D+01/6 . 02  3D+2  3 
RH02— RCON(K, 10 , J)*l . 600D+01/6 . 023D+23 
RH03-RC0N(K, 2 , J)*3 . 200D+01/6 . 023D+23 
RH04— RH01+RH02+RH03 

QVIB-1 . D+0/ ( 1 . D+0 - DEXP ( - 2 . 2 7D+03/TEMP (K , J ) ) ) 

QROT-TEMP (K , J)/4. 2D+0 

C1-RH04+1 . 7725D+01*QVIB*QROT*Q3*DEXP(5 . 950D+04/TEMP(K, J) ) 
C1-C1/(Q1**2*TEMP(K, J)**l .5) 

C2-RH04+7 . 801D+06*Q1*DEXP ( 1 . 58D+05/TEMP (K , J ) ) 
C2=C2/(Q2*TEMP(K, J)**l . 5) 


ALPHA-0. 5D+0 
BETA-0 . 5 D+0 

162  F-BETA**2* ( 1 . D+0 -ALPHA) **2*C1+BETA- 1 . D+0 
FA- - 2 . D+0*BETA**2* ( 1 . D+0 -ALPHA) *C1 
FB-2 . D+0*BETA* (1 . D+O -ALPHA) **2*C1+1 . D+O 
G-ALPHA**  2 *BETA*C  2+ALPHA - 1 . D+O 
GA-2 . D+0*ALPHA*BETA*C2+1 . D+O 
GB-ALPHA**2*C2 
DENOM-FA+GB - FB*GA 
DA- ( -F*GB+G*FB) /DENOM 
DB- ( - G*FA+F*GA) /DENOM 
ALPHA-ALPHA+DA 
BETA-BETA+DB 

IF((DABS(DA) .GT.l.D-05) .OR. (DABS(DB) .GT.l.D-5))  GO  TO  162 
ALPH-RCON (K , 10 , J)/(RCON (K , 10 , J )+RCON (K . 4 , J ) ) 

BET-(RC0N(K, 10 , J)+RC0N(K,4 , J) )/(2 ,D+0*RC0N(K, 2 , J)+ 

* RCON(K, 10 , J)+RCON(K, 4 , J) ) 

IF(IQ6 . EQ. 1)  GO  TO  1999 

BETO(K, J)— (BET**2/(1 .D+O-BET) )*( (1 . D+0 - BETA) /( BETA**2 ) ) 

* * ( ( 1 . D+0 - ALPH) **2/ ( 1 . D+0 -ALPHA) **2 ) 

1999  ALPO (K , J ) -BET* ( ALPH**2/ ( 1 . D+0 -ALPH) ) 

* *( (1 . D+0-ALPHA)/(BETA*ALPHA**2) ) 

142  CONTINUE 

C BETA-BETA(Tt) 

IF(IQ6 . EQ . 1)  THEN 
DO  1122  K-3.NXC0N 
DO  1122  J-l.NPTS(K) 

IF(J . EQ.NPTS (K) ) THEN 
BETN(K.J)— O.D+OO 
GO  TO  1122 
END  IF 
Ql-O.D+O 
Q2-0.D+0 
Q3-0 . D+0 

DO  1112  III— 1 , LI (3) 

1112  Q1-Q1+GIL(III , 3)*DEXP(-EPSIIL(III , 3)/TEMP0(K, J) ) 

DO  1113  III-1,LI(9) 

1113  Q2-Q2+GIL(III , 9)*DEXP(-EPSIIL(III , 9) /TEMPO (K,J) ) 

DO  1130  III— 1 ,LI(1) 

1130  Q3-Q3+GIL(III,l)*DEXP(-EPSIIL(III,l)/TEMPO(K,J)) 

RH01-RC0N ( K , 3 , J ) *1 . 40 1D+0 1/6 . 0 2 3D+2  3 
RH02-RC0N(K, 9 , J)*l . 401D+01/6 . 023D+23 
RH03— RCON (K , 1 , J ) *2 . 802D+01/6 . 023D+23 
RH04-RH01+RH02+RH03 

QVIB-1 . D+0/ ( 1 . D+0 - DEXP ( - 3 . 3 9D+0  3 /TEMPO ( K , J ) ) ) 

QROT-TEMPO (K, J)/5 . 8D+0 

C1-RH04+2 . 4 7 0 1D+0 1*QVIB*QR0T*Q3*DEXP (1.13  5D+05 /TEMPO (K, J) ) 
Cl-Cl/ (Q1**2*TEMP0 (K , J ) **1 . 5 ) 

C2-RH04+8 . 909D+06*Q1*DEXP(1. 69D+05/TEMPO(K, J) ) 

C2-C2/ (Q2*TEMP0(K, J ) **1 . 5 ) 

ALPHA-0 . 5 D+0 
BETA-0 . 5D+0 

1132  F-BETA**2*(1. D+0- ALPHA) **2*C1+BETA-1. D+0 

FA- - 2 . D+0*BETA**2* ( 1 . D+0 -ALPHA) *C1 
FB-2 . D+0*BETA*(1 . D+0 -ALPHA) **2*C1+1 . D+0 
G-ALPHA**2*BETA*C2+ALPHA- 1 . D+0 
GA-2 . D+0*ALPHA*BETA*C2+1 . D+0 
GB-ALPHA**2*C2 
DENOM-FA*GB - FB*GA 
DA- ( - F*GB+G*FB ) /DENOM 


H83 


DB- ( - G*FA+F*GA) /DENOM 

ALPHA-ALPHA+DA 

BETA-BETA+DB 

IF( (DABS (DA) . GT. 1 .D-05) .OR.  (DABS(DB) .GT. 1 .D-5) ) GO  TO  1132 
BET-(RCON(K,9,J)+RCON(K,3,J))/(2.D+0*RCON(K,1,J)+ 

* RCON (K , 9 , J)+RCON (K , 3 , J ) ) 

ALPH-RCON (K , 9 , J ) /(RCON (K , 9 , J)+RCON(K , 3 , J ) ) 

BETN(K,  J)  — (BET**2/(1  .D+O-BET)  )*(  (1 . D+0 - BETA) / (BETA**2 ) ) 

* * ( ( 1 . D+0 - ALPH ) **2/ ( 1 . D+0 -ALPHA) **2 ) 

1122  CONTINUE 

DO  1142  K-3.NXCON 
DO  1142  J— 1 , NPTS (K) 

IF(J . EQ.NPTS (K) ) THEN 
BETO (K , J ) — 0 . D+OO 
GO  TO  1142 
END  IF 
Ql-O.D+O 
Q2-0.D+0 
Q3-0 . D+0 

DO  1152  III— 1 ,LI (4) 

1152  Q1-Q1+GIL(III ,4)*EXP( -EPSIIL(III ,4)/TEMPO(K, J) ) 

DO  1153  III— 1 , LI (10) 

1153  Q2-Q2+GIL(III,10)*DEXP(-EPSIIL(III,10)/TEMPO(K,J)) 

DO  1160  III-1,LI(2) 

1160  Q3-Q3+GIL(III , 2)*DEXP( -EPSIIL(III , 2)/TEMPO(K, J) ) 

RH01-RC0N (K , 4 , J ) *1 . 600D+01/6 . 023D+23 
RH02-RC0N (K , 10 , J ) *1 . 600D+01/6 . 023D+23 
RH03-RC0N(K, 2 , J)*3 . 200D+01/6 . 023D+23 
RH04-RH01+RH02+RH03 

QVIB-1 . D+0/ ( 1 . D+0 - DEXP ( - 2 . 27 D+0 3 /TEMPO (K , J) ) ) 

QROT-TEMPO (K , J ) /4 . 2D+0 

C1-RH04*1 . 7725D+01*QVIB*QR0T*Q3*DEXP(5 . 950D+04/TEMPO  (K , J ) ) 
Cl-Cl/ (Ql**2*TEMPO (K , J ) **1 . 5 ) 

C2-RH04+7 . 801D+06*Q1*DEXP  ( 1 . 5 8D+05/TEMPO (K , J ) ) 

C2-C2/ (Q2*TEMPO (K, J)**l .5) 

ALPHA-0 . 5 D+0 
BETA-0 . 5 D+0 

1162  F-BETA**2*(1. D+0- ALPHA) **2*C1+BETA-1. D+0 

FA—  2 . D+0*BETA**2* ( 1 . D+0 -ALPHA) *C1 
FB-2 . D+0*BETA*(1 . D+0- ALPHA) **2*C1+1 . D+0 
G-ALPHA**2*BETA*C2+ALPHA- 1 . D+0 
GA-2 . D+0*ALPHA*BETA*C2+1 . D+0 
GB-ALPHA**2*C2 
DENOM-FA*GB - FB*GA 
DA- ( - F*GB+G*FB) /DENOM 
DB- ( - G*FA+F*GA) /DENOM 
ALPHA-ALPHA+DA 
BETA-BETA+DB 

IF( (DABS (DA) . GT . 1 . D-05) .OR. (DABS (DB) .GT.l.D-5))  GO  TO  1162 
BET- (RCON (K, 10 , J)+RC0N(K,4 , J) ) /(2 . D+0*RCON(K, 2 , J)+ 

* RCON(K, 10 , J)+RC0N(K,4 , J) ) 

ALPH-RCON (K, 10 , J)/(RCON(K, 10 , J)+RCON(K, 4 , J) ) 

BETO (K , J ) - (BET**2/ ( 1 . D+0 - BET) ) * ( ( 1 . D+0 - BETA) /(BETA**2 ) ) 

* * ( ( 1 . D+0 -ALPH) **2/ ( 1 . D+0 - ALPHA) **2 ) 

1142  CONTINUE 

ENDIF 
END  IF 

ABSORPTION  COEFFICIENTS 

DO  20  K-3 , NXCON 
DO  20  J-1,NPTS(K) 


TT-TEMP(K, J)/168800 . 0 
IF(IQ6 . EQ. 1)  THEN 

TM-TEMPO(K, J)/168800 . 0 
ELSE 
TM-TT 
END  IF 

IF((IQ6.EQ.l) .AND. (TEMPO(K.J) .LE.8.D+03))  GO  TO  20 
IF(TEMP(K,J) .LE.8.D+03)  GO  TO  20 
IF(IQ8 . EQ . 0)  THEN 
O-BETO(K.J) 

N-BETN(K.J) 

ELSE 

0-1 . D+0 
N-l . D+0 
END  IF 

KAPPA(K, 4 , J )-5 . D- 19*0*RC0N (K, 2 , J)+5 . D-20*N*RCON(K,  1 , J) 

KAP(K,4, J)-l. 7D- 17*RCON(K, 3 , J ) *DEXP ( - . 246/TT) 

KA(K, 4 , J)-0 . D+0 

KAPPA (K , 3 , J)-2  . D- 18*(N*RCON(K, 1 , J)+0*RC0N(K,  2 , J)  )+KAPPA(K, 4 , J) 
KAP(K,  3 , J)-2  . ID- 17*RCON(K,  3 , J)*DEXP(  - . 165/TT)+KAP(K, 4 , J) 

KA(K , 3 , J)-0 . D+0 

KAPPA (K,  2 , J)-5  . ID  - 18*(N*RCON(K,  1 , J)+0*RC0N(K,  2 , J)  )+KAPPA(K,  3 , J) 
KAP(K, 2 , J)-KAP(K, 3 , J) 

KA(K, 2 , J)-5 . ID- 18*RCON(K, 4 , J) 

KAPPA (K, 1 , J)— 2 . D-17*0*RC0N (K,  2 , J)+4 . D-16*N*RCON(K, 1 , J) 

C +KAPPA(K, 2 , J) 

KAP(K, 1 , J)-l . 1D-17*RC0N(K, 3 , J)+KAP(K, 2 , J) 

KA(K,1,J)— KA(K,2,J) 

IF(IQ5 . EQ . 0)  THEN 
N-ALPN(K.J) 

O-ALPO(K.J) 

IF(IQ8 . EQ . 0)  THEN 
NN-BETN(K.J) 

OO-BETO(K.J) 

ELSE 

NN-1 . D+0 
00-1 . D+0 
ENDIF 

KAPPA (K, 5 , J)=7 . 7D- 17*(NN*RC0N(K, 1 , J)+00*RC0N(K, 2 , J) ) 

C *DEXP(- . 49/TT)+ 

C 2.6D-17*(RC0N(K,3,J)*N+RC0N(K,4,J)*0)*DEXP(- ,723/TT) 

KAPPA (K , 6 , J)-2 . D- 18*RC0N(K, 2 , J)*00+1 . 5D-17*(RCON(K, 3 , J)*N+ 

C RCON(K , 4 , J )*0)*DEXP ( - . 379/TT)+KAPPA(K, 5 , J) 

IF(RC0N(K,7,J) .LE.l.D+OO)  THEN 
KAPPA(K, 7 , J)— KAPPA(K, 6 , J) 

GO  TO  909 
ENDIF 

KAPPA(K, 7 , J)-3 ,D+03*( (RCON(K, 3 , J)*N+RCON(K, 4 , J)*0)/RC0N(K, 7 , J) )* 
C DEXP( - ,489/TT)+KAPPA(K, 6 , J) 

909  KAPPA (K, 8 , J)— 3 . 2D-17*(RC0N (K, 3 , J)*N+RCON(K, 4 , J)*0)*DEXP( - . 631/TT) 
C +KAPPA(K, 5 , J) 

ELSE 

KAPPA (K, 5 , J)=7 . 7D- 17*(RC0N (K, 1 , J)+RCON (K, 2 , J ) )*DEXP( - . 49/TT)+ 

C 2.6D-17*(RCON(K,3>J)+RCON(K,4,J))*DEXP(- ,723/TT) 

KAPPA(K, 6 , J)=2.D-18*RCON(K,2, J)+l . 5D- 17*(RC0N(K, 3 , J)+RCON(K, 4 , J) ) 
C *DEXP( - . 379/TT)+KAPPA(K, 5 , J) 

IF(RCON(K, 7, J) .LE.l.D+OO)  THEN 
KAPPA(K, 7 , J)=KAPPA(K, 6 , J) 

GO  TO  910 
ENDIF 


KAPPA(K, 7 , J)— 3 .D+03*( (RCON(K, 3 , J)+RC0N(K,4, J) )/RC0N(K, 7 , J) )* 

C DEXP( - .489/TT)+KAPPA(K, 6 , J) 

910  KAPPA(K, 8 , J)— 3 . 2D-17*(RCON(K, 3 , J)+RC0N(K,4 , J) )*DEXP( - . 631/TT) 
C +KAPPA(K, 5 , J) 

ENDIF 

20  CONTINUE 

C PLANCK  FUNCTION 

DO  30  K-3.NXCON 
DO  30  J-l.NPTS(K) 

TT-TEMP(K,J)/168800.0 
C IF(TEMP(K,J) .LE.8.D+03)  GO  TO  30 

BLACK— (TT*168800. )**4*5 . 6696D-12/3 . 1415927 
FF-15 . D+00/(3 . 1415927**4) 

Xl-l./TT 

Bl-FF* (DEXP ( -XI) *( 6 . +6 . *Xl+3 . *X1**2+X1**3 ) + 

C DEXP(-2.*X1)*0 . 5*( . 75+1 . 5*X1+1 . 5*X1**2+X1**3 ) ) 

Xl-0. 935/TT 

B2-FF* ( DEXP ( -XI ) * ( 6 . +6 . *Xl+3 . *X1**2+X1**3 ) + 

C DEXP ( - 2.*X1)*0 . 5*( . 75+1 . 5*X1+1 . 5*X1**2+X1**3) ) 

XI— 0 . 835/TT 

B3-FF* (DEXP ( -XI) * ( 6 . +6 . *Xl+3 . *X1**2+X1**3 ) + 

C DEXP ( - 2 . *X1 ) *0 . 5* ( . 75+1 . 5*X1+1 . 5*X1**2+X1**3 ) ) 

XI— 0 . 754/TT 

B4-FF* ( DEXP ( -XI ) * ( 6 . +6 . *Xl+3 . *X1**2+X1**3 ) + 

C DEXP ( - 2 . *X1)*0 . 5*( . 75+1 . 5*X1+1 . 5*X1**2+X1**3) ) 

XI— 0.473/TT 

B6— FF*(DEXP( -Xl)*(6 . +6 . *Xl+3 . *X1**2+X1**3)+ 

C DEXP ( - 2 . *X1)*0 . 5*( . 75+1 . 5+X1+1 . 5*X1**2+X1**3) ) 

Xl-0. 213/TT 

B8-FF* ( DEXP ( -XI ) * ( 6 . +6 . *Xl+3 . *X1**2+X1**  3 ) + 

C DEXP ( - 2 . *X1) *0 . 5* ( . 75+1 . 5*X1+1 . 5*X1**2+X1**3 ) ) 

B8-1-B8 

B2-B2-B1 

B3-B3-B2 

B4-B4-B3 

B6-B6-B4 

B5-1-B8-B6-B4-B3-B2-B1 
B(K,1,J)-BLACK*B1 
B(K, 2 , J)— BLACK*B2 
B (K , 3 , J ) — BLACK*B3 
B (K , 4 , J )— BLACK*B4 
B(K, 6 , J)— BLACK*B6 

B (K , 7 , J ) — BLACK*2 . 4D - 21*RCON (K, 7 , J)*B6*DEXP( . 162/TT) 

B(K, 8 , J)— BLACK*B8 
B(K, 5 , J)— BLACK*B5 
30  CONTINUE 

C TAU'S 

DO  100  K-3 , NXCON 
DO  100  1-1,8 
IF(I.GT.4)  THEN 

OPTL(K, I , 1)— KAPPA(K, I , 1)*DABS(Y(K, 1) -YBDY(K) ) 

ELSE 

OPTL(K, I , 1)— (KAPPA(K, I , 1)+KAP(K, I , 1)+KA(K, I , 1) ) 

C *DABS(Y(K, 1) -YBDY(K) ) 

ENDIF 

DO  100  J-2,NPTS(K) 

IF(I.GT.4)  THEN 

K11-KAPPA(K , I , J )+KAPPA(K , I , J - 1 ) 

ELSE 

K11-KAPPA(K, I , J)+KAP(K, I , J)+KAPPA(K, I , J-1)+KAP(K, I , J-l) 


*i8t> 


c 


+KA(K, I , J)+KA(K, I , J-l) 

ENDIF 

OPTL(K, I , J)— OPTL(K, I , J-l)+(5 .D-1*(K11)*DABS(Y(K, J-l) 

C -Y(K, J) ) ) 

100  CONTINUE 

C QRW 

DO  200  K-3.NXCON 
WRITE(* , 102)  XPST(K) 

WRITE(8 , 102)  XPST(K) 

102  FORMAT (///, ' AT  X - '.Dll. 4) 

WQR-0 . 0 

DO  180  1-1,8 

CALL  FEI (Ell . E2I , E3I , OPTL(K, I , 1) ) 

EOLD-E2I 

JIN-1 

IF(I.GT.4)  THEN 

K11-KAPPA(K, I , 1)*B(K, I , 1) 

ELSE 

IF(IQ5 . EQ. 1)  THEN 
ALPN (K , 1 ) — 1 . D+0 
ALPO(K, l)-l.D+0 
ENDIF 

Kll— KAPPA(K,  1 , 1)*B(K,  1 , 1)+KAP(K,  1 , 1)*B(K,  1 , 1)*ALPN(K, 1)+ 
C KA(K, I , 1)*B(K, I , l)*ALPO(K, 1) 

ENDIF 

SUM-3 . 1415927*E0LD*K11*DABS (Y(K, 1) -YBDY(K) ) 

IF(IQ9 . EQ . 0)  WRITE(8 , 2221)  JIN,I,SUM 
DO  150  J-2,NPTS(K) 

IF(I . GT . 4)  THEN 

K11-KAPPA(K, I ,J)*B(K,I,J) 

K22— KAPPA (K, I,J-1)*B(K,I,J-1) 

ELSE 

IF(IQ5 . EQ. 1)  THEN 
ALPN (K,J)-1. D+0 
ALPO(K, J)-l.D+0 
ENDIF 

Kll— KAPPA(K,  I , J)*B(K,  I , J)+KAP(K,  I , J)*B(K,  I , J)*ALPN(K,  J)+ 
C KA(K,I,J)*B(K,I , J)*ALPO(K, J) 

K22— KAPPA(K, I,J-1)*B(K,I,J-1)+ 

C KAP(K,I,J-1)*B(K,I, J-1)*ALPN(K,J-1)+ 

C KA(K, I,J-1)*B(K,I,J -l)*ALPO(K, J-l) 

ENDIF 

Z-OPTL(K.I.J) 

CALL  FEI (Ell , E2I , E3I , Z) 

STSUM-3 . 14159* (Kll*E2I+K22*EOLD) *DA£S (Y(K , J - 1)  - Y(K , J ) ) 
IF(IQ9 . EQ . 0)  THEN 
WRITE(8 , 2221)  J.I.STSUM 

2221  FORMAT (IX, ' AT  J -',12,'  BAND  ',12,'  QR-',D11.4) 

ENDIF 

145  SUM-SUM+STSUM 
EOLD-E2I 
150  CONTINUE 

WRITE(* , 103)  I, SUM 
WRITE (8 , 103)  I, SUM 

103  FORMAT ( / , ’ FOR  BAND  ',12,'  QR  - '.D11.4,'  WATTS/SQ.CM.') 
WQR— WQR+SUM 

180  CONTINUE 

WRITE(* , 101)  WQR 
WRITE (8, 101)  WQR 

101  FORMAT (/'  TOTAL  QR  = '.D11.4,'  WATTS/SQ.CM.') 


o o o o o 


200  CONTINUE 
RETURN 
END 


SUBROUTINE  FEI  (Ell , E2I , E3I , Z) 

IMPLICIT  REAL*8(A-H,0-Z) 

COMMON  /RADI/  RRHO(30 ,30) ,Y(30 , 30) , YBDY(30) 

COMMON  /RAD3/  B(30,8,30) 

COMMON  /RAD5/  OPTL(30 , 8 , 30) 

REAL  OPTL.XPST.Y.YBDY, TEMPO, TEMP, Z 
REAL  ALPN , ALPO , B , BETN , BETO 
CALL  EXPI(Z,E1I,AUX) 

E2I-DEXP(-Z)-Z*E1I 
E3I-(DEXP(-Z)-Z*E2I)/2.0 
C E2I-DEXP( -Z*DSQRT(3 .D+00) ) 

RETURN 

END 

C 

C 

c 

SUBROUTINE  EXPI(X,RES ,AUX) 

IMPLICIT  REAL*8(A-H,0-Z) 

COMMON  /RADI/  RRHO(30 , 30) ,Y(30 , 30) , YBDY(30) 

COMMON  /RAD3/  B(30,8,30) 

COMMON  /RAD5/  OPTL(30, 8 , 30) 

C REAL  OPTL  ,XPST ,Y,YBDY , TEMPO , TEMP , Z 

C REAL  ALPN, ALPO, B, BETN, BETO 

IF(X-1 . ) 2,1,1 

1 YY-l./X 

AUX-1. -YY*(((YY+3.377358)*YY+2.052156)*YY+2.709479D-01)/((((YY* 

Cl . 072553+5 . 716943)*YY+6 . 945239)*YY+2 . 593888)*YY+2 . 709496D-01) 
RES-AUX*YY*DEXP ( -X) 

RETURN 

2 IF(X+3 . ) 6,6,3 

3 AUX-( ( ( ( ( ( (7 . 122452D-7*X-1. 766345D-6)*X+2 . 928433D-5)*X-2 . 335379D-4 
C)*X+1 . 664156D-3)*X-1. 041576D-2)*X+5 . 555682D-2)*X-2 . 500001D-1)*X 
C+9 . 999999D-1 

RES— l.D+30 
IF(X)  4,5,4 

4 RES-X*AUX-DLOG (ABS (X) ) -5 . 772157D-1 

5 RETURN 

6 IF(X+9 . ) 8,8,7 

7 AUX-1 . - ( ( ( (5 . 176245D-2*X+3 . 061037)*X+3 . 243655D+l)*X+2 . 244234D+2)*X 
C+2 . 486697D+2)/( ( ( (X+3 . 995161)*X+3 . 893944D+l)*X+2 . 263818D+1)*X 

C+l . 807837D+2) 

GO  TO  9 

8 YY-9 . /X 

• AUX-1 . -YY*( ( (YY+7 . 659824D- l)*YY-7 . 271015D-1)*YY-1 . 080693)/( ( ( (YY 
C*2 . 518750+1 . 122927D+l)*YY+5 . 921405)*YY-8 . 666702)*YY-9 . 724216) 

9 RES=AUX*DEXP ( -X) /X 
RETURN 

END 


LISTING  OF  INPUT  FILE  RR3.NUM 


489 


3 


10.22.83146900. . 1.4 

20. . 5.65. .3. .01 

3392.14.28.016.1.0.  .768.4.1.114981. .0,-. 42163 

2275. . 32. .1.0. .232.6.1.60500. .0.1.21618 

1. 14. 008.0.  4. 707E+12, 0,4, 1,0, 0,1. 67997 

1.16. . 0.2. 4681E+12, 0,5, 1,0, 0,2. 1032 

2739.  , 30. 008,1, 9. 0073E+11, 0,8, 1,76883., 0,1. 23256 

3421. . 30. 008. 1.1. 0826E+13. 0,3, 1,127698. ,0, .3786099 
1, 5. 4862E-04, 0,0, 0,1, 1,0, 0,-14. 23517 

3129. .  28. 016. 1.1.505E+13, 0,4, 1,101242. 3, 0,1. 00426 

1. 14. 008. 0. 1.8759E+13, 0,6, 1,0,0, .29368 

1.16. . 0.1.5625E+13,0,5,1,0,0,1.8794 
2, 1.19E+21, -1.5,59380. ,1. 

5,5.18E+21, -1.5,75490. ,1. 

3,5. OE+19 , - 1 . 5 , 0 , 2 . 

2,1. 0E+12 ,0.5, 3120 . ,1. 

1, 5. 0E+13, 0,38016. ,1. 

6,1. 8E+21.-1. 5,0,1. 

3, 1.4E+13, 0,67800,1. 

3, 2. 34E+11, 0.5, 120000,1. 

9, 2. 34E+11, 0.5, 120000,1. 

3, 1.1E+32, -3.14,169000,1. 


4 , 2 . 77E+12 , 0 . 5 , 157500 . ,1. 

4.2. 

3.2. 

1,1. 

5.2. 

5.2. 

8.2. 

9,2. 

9,2. 

9,2. 

9.2. 

10.2. 

64,1 

64,1 

64,1 

64,1 

64,1 

64,1 

64,1 

64,1 

64,1 

64,1 

64,1 

64,1 

64,1 

64,1 

64,1 

64,1 

64,1 


64 , 1 

64,1 

64,1 

64,1 

1,1, 1,1, 1,1, 0,0, 0,0, 0,0, 0,0, 0,0, 0,0, 0,0, 1,1 

1,1, 1,1, 1,1, 0,0, 0,0, 0,0, 0,0, 0,0, 0,0, 0,0, 1,1 

1,1, 1,1, 1,1, 0,0, 0,0, 0,0, 0,0, 0,0, 0,0, 0,0, 1,1 

1,1, 1,1, 1,1, 0,0, 0,0, 0,0, 0,0, 0,0, 0,0, 0,0, 1,1 

1,1, 1,1, 1,1, 0,0, 0,0, 0,0, 0,0, 0,0, 0,0, 0,0, 1,1 


1.1, 1.1. 1.1. 0,0, 0,0, 0,0,0, 0,0, 0,0, 0,0, 0,1,1 
0,0, 0,0, 0,0, 0,0, 0,0, 0,0, 0,0, 0,0, 0,0,0, 0,0,0 

1,1, 1,1, 1,1, 0,0, 0,0, 0,0, 0,0, 0,0, 0,0,0, 0,1,1 

1,1, 1,1, 1,1, 0,0, 0,0, 0,0, 0,0, 0,0, 0,0, 0,0, 1,1 

1,1, 1,1, 1,1, 0,0, 0,0, 0,0, 0,0, 0,0, 0,0, 0,0, 1,1 
0,1, 0,0, 0,0, 0,0, 0,0,1 
0,0, 0,2, 0,0, 0,0, 0,0,1 
0,0, 0,0, 1,0, 0,0, 0,0,1 
0,0, 1,1, 0,0, 0,0, 0,0,1 

1.0, 0,0, 0,0, 0,0, 0,0,1 
0,0, 2, 0,0, 0,0, 0,0, 0,1 
0,1, 1,0, 0,0, 0,0, 0,0,0 
0,0, 0,1, 1,0, 0,0, 0,0,0 

1,0. 0,1, 0,0, 0,0, 0,0,0 
0,0, 1,0, 1,0, 0,0, 0,0,0 
0,0, 0,0, 0,1, 1,0, 0,0,0 
0.0, 1,1, 0,0, 0,0, 0,0,0 
0,0, 2, 0,0, 0,0, 0,0, 0,0 
0,0, 0,0, 0,0, 1,1, 0,0,0 
0,0, 2, 0,0, 0,0, 0,0, 0,0 
0,0, 1,0, 0,0, 1,0, 1,0,0 
0,0, 1,0, 0,0, 0,0, 1,0,0 
0,0, 0,0, 0,0, 1,0, 2, 0,0 
0,0, 1,0, 0,0, 1,0, 0,0,0 
0,0, 0,0, 0,0, 2, 0,1, 0,0 
0,0, 0,1, 0,0, 0,0, 0,0,1 
0,0, 0,0, 0,0, 1,0, 0,1,1 
0,0, 0,2, 0,0, 0,0, 0,0 
0,1, 0,0, 0,0, 0,0, 0,0 
0,0, 1,1, 0,0, 0,0, 0,0 
0,0, 0,0, 1,0, 0,0, 0,0 
0,0, 2, 0,0, 0,0, 0,0,0 

1,0, 0,0, 0,0, 0,0, 0,0 
0,0, 0,1, 1,0, 0,0, 0,0 
0,1, 1,0, 0,0, 0,0, 0,0 
0,0, 1,0, 1,0, 0,0, 0,0 

1,0, 0,1, 0,0, 0,0, 0,0 
0,0, 1,1, 0,0, 0,0, 0,0 
0,0, 0,0, 0,1, 1,0, 0,0 
0,0, 0,0, 0,0, 1,1, 0,0 
0,0, 2, 0,0, 0,0, 0,0,0 
0,0, 1,0, 0,0, 1,0, 1,0 
0,0, 2, 0,0, 0,0, 0,0,0 
0,0, 0,0, 0,0, 1,0, 2,0 
0,0, 1,0, 0,0, 0,0, 1,0 
0,0, 0,0, 0,0, 2, 0,1,0 
0,0, 1,0, 0,0, 1,0, 0,0 
0, 0, 0,0, 0,0, 1,0,0, 1 
0,0, 0,1, 0,0, 0,0, 0,0 

5.675E-04,5.675E-04,5.675E-04,5.675E-04,5.675E-04,5.675E-04,5.675E-04,5.675E-04, 

5.675E-04.5.675E-04 

1 .443E-07 , 1 . 443E-07 , 1 . 443E-07 , 1 . 443E-07 , 1 . 443 E- 07 , 1 . 443E-07 , 1 . 443E-07 , 1 .443 E- 07 , 
1 . 443E-07 , 1 . 443E-07 
0,0, 0,0,0, 0,0, 0,0,0 
0,0, 0,0, 0,0, 0,0, 0,0 

1.513E-04,1.513E-04,1.513E-04,1.513E-04,1.513E-04,1.513E-04,1.513E-04,1.513E-04, 

1.513E-04.1.513E-04 

1.513E-04,1.513E-04,1.513E-04,1.513E-04,1. 513E-04 ,1.513E-04,1.513E-04,1.513E-04, 
1.513E-04.1.513E-04 
0,0, 0,0, 0,0, 0,0, 0,0 


nil 


I 


5.675E-04,5.675E-04,5.675E-04,5.675E-04,5.675E-04,5.675E-04,5.675E-04,5.675E-04, 
5 . 675E-04 , 5 . 675E-04 
0,0, 0,0,0, 0,0, 0,0,0 
0,0, 0,0, 0.0, 0,0, 0,0 

-.09952, -.09952, -.09952, -.09952, -.09952, -.09952, -.09952, -.09952, -.09952, -.09952 
.37177, .37177, .37177, .37177, .37177, .37177, .37177, .37177, .37177, .37177 
0,0, 0,0, 0,0, 0,0, 0,0 
0,0, 0,0, 0,0, 0,0, 0,0 

-.2226, -.2226, -.2226, -.2226, -.2226, -.2226, -.2226, -.2226, -.2226, -.2226 
-.2226, -.2226, -.2226, -.2226, -.2226, -.2226, -.2226, -.2226, -.2226, -.2226 
0,0, 0,0, 0,0, 0,0, 0,0 

-.09952, -.09952, -.09952, -.09952, -.09952, -.09952, -.09952, -.09952, -.09952, -.09952 
0,0, 0,0, 0,0, 0,0, 0,0 
0,0, 0,0, 0,0, 0,0, 0,0 

163.63,163.63,163.63,163.63,163.63,163.63,163.63,163.63,163.63,163.63 
179.32,179.32,179.32,179.32,179.32,179.32,179.32,179.32,179.32,179.32 
0,0, 0,0, 0,0, 0,0, 0,0 
0,0, 0,0, 0,0, 0,0, 0,0 

135.3,135.3,135.3,135.3,135.3,135.3,135.3,135.3,135.3,135.3 

135.3.135.3.135.3.135.3.135.3.135.3.135.3.135.3.135.3.135.3 

0,0, 0,0, 0,0, 0,0, 0,0 

163.63,163.63,163.63,163.63,163.63,163.63,163.63,163.63,163.63,163.63 
0,0, 0,0, 0,0, 0,0, 0,0 
0,0, 0,0, 0,0, 0,0, 0,0 

1.3. 6. 2 

3. 2. 1.3. 1.3 
4, 6,4, 6 

5, 3, 1,5,1 

2, 2, 2, 4, 2, 4, 2, 4 

1.6.3 
1 

2. 4. 2. 2 
1.3. 5, 5, 1,5 

4. 6. 4. 4. 2 

0 i 71592 ! 85343 , 99212 
0,11342,18879,51385,52104,71026 
0,27659,27670,41496 
0,228,326,22831,48622 

0,174,63597,65381,76676,75361,87568,86359 

0,57528,84205 

0 

0,13191,36634,92977.4 

0,70.5,188.5, 22036 . 5 , 47029 . 68 , 67864.8 

0,38571,38601,58223.5,58225 

46, 18800, 3393. 9685, 20. 797195, 1 . 0801997E-02 , -7. 32343E-04 
33, 9896, 2273. 1279, 17. 365295, 7. 8529954E-02, -2.057468E-03 
0,0, 0,0, 0,0 
0,0, 0,0, 0,0 
0,0, 0,0, 0,0 
0,0, 0,0, 0,0 
0,0, 0,0, 0,0 
0,0, 0,0, 0,0 
0, 0,0, 0,0,0 
0,0, 0,0, 0,0 
M2 
02 
>J 
0 

MO 

M0+ 


w 


E* 

N2+ 

N+ 

0+ 

02  +Ji. .>20_+_M 
20_+_M.  ,>02_+_M 
N°_+_K . . >N_+_0_+_M 
N_+_0_+_M.  . >N0_+_M 
N2_+_M. .>2N_+_M 
2N_+_M . .>N2_+_M 
N_+_02. *>N0_+_0 
N0_+_0. ,>N_+_02 
N2_+_0 . . >N0__+_N 
N0_+_N. .>N2_+_0 
N0+_+_E-.  ,>N_+_0 
N_+_0 . .>N0+_+_E- 
N_+_N. .>N2+_+_E- 
N2+_+_E- . ,>N_+_N 
N_+_N . . >N+_+_E  - _+_N 
N+_+_E  - _+_N . . >N_+_N 
N_+_N+ . . >N+_+_E  - _+_N+ 
N+_+_E  -_+_N+ . . >N_+_N+ 
N_+_E - . .>N+_+_2E- 
N+_+_2E- . . >N_+_E - 
0_+_M . . >0+_4_E  - _+__M 
0+  + E-  + K. .>0  + M 
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C PROGRAM  FOR  COMPUTING  THE  RADIATIVE  HEAT  TRANSFER  AT  THE  BODY  SURFACE 
C IN  A HYPERSONIC  FLOWFIELD.  THIS  PROGRAM  IS  USED  IN  CONJUNCTION  WITH 
C AFE2 . FOR 
C 

C RADIATION  MODELS  1)  OLSTAD  MODEL 

C 2)  CARLSON  MODEL 

C 

IMPLICIT  REAL*8(A-H,0-Z) 

COMMON  /A9/  MUI(25) ,XPST(30) 

COMMON  /RAD/  NXCON,NPTS(30) ,TSTAG,LI(25) ,IMAX 
COMMON  /RADI/  RRHO(30 , 30) , Y(30 , 30) , YBDY(30) 

COMMON  /RAD2/  RCON(30 , 10 , 30) 

COMMON  /RAD3/  B(30,8,30) 

COMMON  /RAD5/  OPTL(30 , 8 , 30) 

COMMON  /RAD6/  ALPN(30 , 30) , ALPO(30 , 30) , BETN(30 , 30) , BETO(30 , 30) 

COMMON  /RAD7/  TEMPO(30 , 30) ,TEMP(30 , 30) 

COMMON  /RAD8/  KAP(30,4,30) 

COMMON  /RAD9/  KAPPA(30 , 8 , 30) ,KA(30 , 4 , 30) 

COMMON  /RADIO/  EPSIIL(20 , 25) , GIL(20 , 25) 

REAL  OPTL,XPST,Y,YBDY, TEMPO, TEMP ,Z 
REAL  ALPN , ALPO , B , BETN , BETO 
REAL* 8 KAPPA , KAP.KA.MUI.EPS I IL, GIL 
CHARACTER*30  OUTFIL 

C OPEN  RADIATION  INPUT  FILES.  (AFE2 . FOR) 

OPEN  (UNIT-15 , FILE- ' RADIN1 . DAT ' , STATUS- ' OLD ' ) 

OPEN  (UNIT-1 6, FILE- 'RADIN2.DAT' , STATUS-' OLD ' ) 

OPEN  (UNIT-17 , FILE- ' RADIN3 . DAT ' , STATUS- ' OLD ' ) 

C READ  INPUT 

READ (15,1)  OUTFIL 

1 FORMAT (A3 0) 

READ ( 15 , *)  MODEL , IQ3 , VINF , TINF , PINF 
READ ( 15 , *)  NXPST , NXCON , IMAX , IQ4 , IQ5 , IQ6 , IQ8 , IQ9 
IF  (NXCON. GT. 30)  THEN 
WRITE(* ,2)  NXCON 

2 FORMAT  (IX, 'NXCON  - ',13,'  MAX  - 30  STRLNES  IN  RAD. FOR') 

STOP 

ENDIF 

IF  (IQ4.EQ.0)  GO  TO  60 

OPEN  (UNIT-8, FILE-OUTFIL , STATUS- ' UNKNOWN ' ) 

DO  5 I - 1 , IMAX 
5 READ(15 ,*)  MUI(I) 

DO  7 I - 1 , IMAX 
READ  (15,*)  LI  I 
LI  (I)  - LI  I 

7 READ(15 ,*)  (GIL(L, I) ,L  - l.LII) 

DO  9 I - 1 , IMAX 
READ(15 ,*)  LI I 

9 READ (15 , *)  (EPSIIL(L.I) ,L  - 1,LII) 

DO  10  I - 1, NXPST 
10  READ(15 ,*)  NPTS(I) ,XPST(I) 

READ (15,*)  TSTAG 
READ (15,*)  KSTAG 
DO  15  I - 1, KSTAG 
READ (16,*)  LPS2 , JJJ 
IF  (IMAX.EQ.7)  THEN 

READ(16,*)  RCON(LPS2 , 1, JJJ) ,RCON(LPS2 , 2 , JJJ) , RCON(LPS2 , 3 , JJJ) , 

* RCON(LPS2 , 4 , JJJ) , RCON(LPS2 , 5 , JJJ) ,RCON(LPS2 , 6 , JJJ) , 

* RCON(LPS2,7,JJJ) ,RRHO(LPS2, JJJ) , TEMP (LPS2 , JJJ) , 

* TEMPO(LPS2 , JJJ) 

ENDIF 


IF  (IMAX. EQ. 10)  THEN 

READ(16 ,*)  RCON(LPS2 , 1 , JJJ) ,RCON(LPS2 ,2 , JJJ) ,RC0N(LPS2 , 3 . JJJ) , 

* RCON(LPS2,4,JJJ) , RC0N(LPS2 , 5 , JJJ) ,RCON(LPS2 , 6 , JJJ) , 

* RCON(LPS2 , 7 , JJJ) ,RCON(LPS2,8,JJJ) ,RC0N(LPS2 , 9 , JJJ) , 

* RCON(LPS2,10,JJJ) ,RRHO(LPS2,JJJ),TEMP(LPS2,JJJ) . 

* TEMPO (LPS2, JJJ) 

ENDIF 

15  CONTINUE 

19  READ(17,*, END-21)  IBOB.IK 
READ (17,*)  YBDY(IBOB) 

DO  20  J - 2, IK 

20  READ(17,*)  Y(IBOB.J-l) 

GO  TO  19 

C INITIAL  CONDITIONS 

21  WRITE(*,22)  VINF.PINF.TINF 
WRITE (8 , 22)  VINF.PINF.TINF 

22  FORMAT ( IX , 'FREESTREAM  QUANTITIES  : * ,//,lX, 'VINF  - \E12.5,1X, 

* 'cm/sec' ,/,lX, 'PINF  - ' , E12 . 5 , IX, ' dynes/cmA2 ' ,/, IX, 

* 'TINF  - ' .E12.5.1X, 'K'///) 

WRITE (*,23)  MODEL 

WRITE (8 , 23)  MODEL 

23  F0RMAT(1X, 'VIBRATION-DISSOCIATION  COUPLING  MODELS 12X , 

* 'TYPE' ,11X, 'NO. ' ,//,9X, 'VIB.  EQUIL. ' , 8X, ' 0 ' ,/, 12X, ' CVD' , 13X, 

* '1'  ,/, 12X, ' CVDV' , 12X, ' 2 ' , / , 6X , 'CVDV-Preferential' , 5X, '3' ,/, 

* 12X, 'PARK' ,12X, '4' , ' - ',13///) 

WRITE(*,24)  IQ3 

WRITE (8, 24)  IQ3 

24  FORMAT (7X, 'SHOCK  JUMP  CONDITION  MODELS ',//, 12X, 

* 'TYPE' ,11X, 'NO. ' ,//,6X, 'CHEMISTRY  FROZEN' , 6X, ' 1 ',/, 5X, 

* 'N2  FROZEN,  02  DISS. ' ,4X, '2' ,/,7X, 'N2  AND  02  DISS.',6X, 

* '3','  - ' ,13///) 

C RADIATION  MODELS 

IF  (IQ4.EQ.1)  CALL  OLRAD  (IQS , IQ6 , IQ8 , IQ9) 

C IF  (IQ4.EQ.2)  CALL  CARLRAD  (IQ4 , IQ5 , IQ9) 

IF  ((IQ4.EQ.3) .OR. (IQ4.EQ.4))  THEN 
CALL  OLRAD  (IQ5 , IQ6 , IQ8 , IQ9) 

C CALL  CARLRAD  (IQ4.IQ5 , IQ9) 

ENDIF 

IF  (IQ4.EQ.4)  THEN 
IF  (IQ5.EQ.0)THEN 
DO  1920  K-3,  NXCON 
WRITE(8 , 30)XPST(K) 

DO  1920  J-l.NPTS(K) 

WRITE (8 , 1921) J , ALPN(K, J) ,ALP0(K, J) ,BETN(K, J) ,BETO(K, J) 

1921  FORMAT ( ' J-',I2,'  An-', Dll. 4,'  Ao-' ,D11.4/ 

* ' ' , 2X, ' BN-', Dll. 4,'  AO-', Dll. 4) 

1920  CONTINUE 

ENDIF 

DO  40  K - 3, NXCON 
WRITE(* , 30)  XPST(K) 

WRITE(8 , 30)  XPST(K) 

30  FORMAT (///, 'AT  X - ',D11.4,///) 

DO  40  J = l.NPTS(K) 

WRITE(*,35)  J ,TEMP(K, J) ,RRHO(K, J) , TEMPO (K,J) 

WRITE(8 , 35)  J,TEMP(K, J) , RRHO(K, J) , TEMPO (K,J) 

35  FORMAT ( ' J - ’,12,'  TVN2  = '.F10.2,'  RHO  - '.Dll. 4,'  T-’,F10.2) 
40  CONTINUE 

DO  55  K = 3, NXCON 
WRITE(*,30)  XPST(K) 

WRITE (8 , 30)  XPST(K) 


DO  55  J - 1 ,NPTS (K) 

WRITE(*,45)  J 
WRITE(8 ,45)  J 

45  FORMAT(/,'  AT  J - ',12,'  THE  NUMBER  DENSITIES  ARE  ' ,/) 

DO  55  I - l.IMAX 
WRITE(8 , 50)  I ,RCON(K, I , J) 

WRITE(*, 50)  I ,RCON(K, I , J) 

50  FORMAT  ( ' SPECIES  - ',12,'  N - \D11.4) 

55  CONTINUE 
ENDIF 
CLOSE(8) 

60  CLOSE(15) 

CLOSE(16) 

CLOSE(17) 

STOP 

END 

C 

C 

c 

SUBROUTINE  OLRAD  (IQ5 , IQ6 , IQ8 , IQ9) 

IMPLICIT  REAL*8(A-H,0-Z) 

COMMON  /A9/  MUI(25) ,XPST(30) 

COMMON  /RAD/  NXCON , NPTS ( 3 0 ) , TSTAG , LI ( 2 5 ) , IMAX 
COMMON  /RADI/  RRHO(30 , 30) , Y(30 , 30) , YBDY(30) 

COMMON  /RAD2/  RCON(30 , 10 , 30) 

COMMON  /RAD3/  B(30,8,30) 

COMMON  /RAD5/  OPTL(30 , 8 , 30) 

COMMON  /RAD6/  ALPN(30 , 30) , ALPO(30 , 30) ,BETN(30 , 30) ,BETO(30 , 30) 

COMMON  /RAD7/  TEMPO(30 , 30) ,TEMP(30 , 30) 

COMMON  /RAD8/  KAP(30,4,30) 

COMMON  /RAD9/  KAPPA(30 , 8 , 30) ,KA(30 , 4 , 30) 

COMMON  /RADIO/  EPSIIL(20 , 25) , GIL(20 , 25) 

C REAL  OPTL,XPST,Y,YBDY, TEMPO, TEMP, Z 
C REAL  ALPN , ALPO , B , BETN , BETO , EPSIIL, GIL 
REAL* 8 Kll , K22 , N , NN , KAPPA , KAP , KA , MUI 

c ■ 

WRITE (8 , 1) 

1 FORMAT (///'  OLSTAD  RADIATION  MODEL') 

IF(IQ8.EQ.O)  THEN 

IF(IQ6 . EQ . 0)  WRITE(8 , 2) 

IF(IQ6 . EQ. I)  WRITE (8 , 3) 

ENDIF 

2 FORMAT (/'  BETA— BETA(Te) ' ) 

3 FORMAT (/'  BETA-BETA ( Tt) ') 

C NUMBER  DENSITIES 

DO  12  K-3, NXCON 
DO  12  J-l.NPTS(K) 

DO  10  II-l.IMAX 
XXX-RRHO(K, J)*6 . 023D+23 
XXX-XXX*RCON  ( K , 1 1 , J ) /MUI  ( 1 1 ) 

10  RCON(K, II , J)-XXX 
12  CONTINUE 

' NONEQUILIBRIUM  RADIATION  CORRECTION 

IF  (IQ5.EQ.0)  THEN 
DO  122  K=3, NXCON 
DO  122  J-l.NPTS(K) 

IF ( J . EQ . NPTS (K) ) THEN 
ALPN(K,J)— 0.D+00 
BETN (K , J ) -0 . D+00 
GO  TO  122 


H^7 


ENDIF 
Ql-0 . D+0 
Q2-0.D+0 
Q3-0.D+0 

DO  112  III-1,LI(3) 

112  Ql— Q1+GIL(III , 3)*DEXP(  -EPSIIL(III , 3)/TEKP(K,  J)  ) 

DO  113  III— 1,LI(9) 

113  Q2-Q2+GIL(III , 9)*DEXP(-EPSIIL(III , 9)/TEMP(K,  J)  ) 

DO  130  III— 1,LI(1) 

130  Q3-Q3+GIL(III , 1)*DEXP( -EPSIIL(III , 1)/TEHP(K,  J)  ) 

RHOl— RCON(K, 3 , J)*l .401D+01/6 . 023D+23 
RH02— RCON(K, 9 , J)*l .401D+01/6 . 023D+23 
RH03-RC0N(K, 1 , J)*2 . 802D+01/6 .023D+23 
RH04— RH01+RH02+RH03 

QVIB-1 . D+O/ ( 1 . D+0 - DEXP (-3.3  9D+03/TEMP (K , J) ) ) 

QROT-TEMP (K , J)/5. 8D+0 

Cl— RH04*2 . 4701D+01*QVIB*QROT*Q3*DEXP ( 1 . 135D+05/TEMP(K, J) ) 
C1-C1/(Q1**2*TEMP(K, J)**l. 5) 

C2-RH04+8 . 909D+06*Q1*DEXP(1 . 69D+05/TEMP(K, J) ) 

C2— C2/(Q2*TEMP(K, J)**l. 5) 

ALPHA-0 . 5 D+0 
BETA-0 . 5 D+0 

132  F-BETA**2* ( 1 . D+0 -ALPHA) **2*C1+BETA- 1 . D+0 
FA—  2 . D+0*BETA**2* ( 1 . D+0 -ALPHA) *C1 
FB-2 . D+O+BETA* ( 1 . D+0 -ALPHA) **2*C1+1 . D+0 
G-ALPHA**2*BETA*C2+ALPHA - 1 . D+0 
GA-2 . D+0*ALPHA*BETA*C2+1 . D+0 
GB-ALPHA**2*C2 
DENOM-FA*GB - FB*GA 
DA- ( - F*GB+G*FB ) /DENOM 
DB- ( - G*FA+F*GA) /DENOM 
ALPHA-ALPHA+DA 
BETA-BETA+DB 

IF( (DABS (DA) .GT. 1 .D-05) .OR.  (DABS(DB) .GT. 1 .D-5) ) GO  TO  132 
ALPH-RCON (K , 9 , J)/(RCON(K, 9 , J )+RCON (K , 3 , J ) ) 

BET— (RCON(K, 9 , J)+RCON(K, 3 ,J))/(2.D+0*RCON(K, 1 , J)+ 

* RCON (K , 9 , J ) +RCON (K , 3 , J ) ) 

IF(IQ6 . EQ. 1)  GO  TO  1888 

BETN (K , J )- (BET**2/ ( 1 . D+0 - BET) ) * ( ( 1 . D+0 - BETA) /(BETA**2 ) ) 

* * ( ( 1 . D+0 - ALPH) **2/ ( 1 . D+0 -ALPHA) **2 ) 

1888  ALPN (K , J ) -BET* ( ALPH**2/ ( 1 . D+0 -ALPH ) ) 

* * ( ( 1 . D+0 - ALPHA) / ( BETA*ALPHA**2 ) ) 

122  CONTINUE 

DO  142  K-3 , NXCON 
DO  142  J-l ,NPTS(K) 

IF(J . EQ.NPTS (K) ) THEN 
ALPO(K.J)— 0.D+00 
BETO(K,J)— 0.D+00 
GO  TO  142 
ENDIF 
Ql-0 . D+0 
Q2-0 . D+0 
Q3-0 . D+0 

DO  152  III-1,LI(4) 

152  Q1=Q1+GIL(III , 4)*EXP( -EPSIIL(III ,4)/TEMP(K, J) ) 

DO  153  III-l , LI (10) 

153  Q2=Q2+GIL(III , 10)*DEXP( -EPSIIL(III , 10)/TEMP(K, J) ) 

DO  160  111=1 , LI (2) 

160  Q3-Q3+GIL(III,2)*DEXP(-EPSIIL(III,2)/TEMP(K.J)) 
RH01-RC0N(K, 4 , J)*l . 600D+01/6 . 023D+23 


RH02-RCON(K, 10 , J)*l . 600D+01/6 . 023D+23 
RH03-RC0N (K , 2 , J ) *3 . 200D+01/6 .023D+23 
RH04-RH01+RH02+RH03 

QVIB-1 . D+0/ ( 1 . D+0 - DEXP ( - 2 . 27D+03/TEMP ( K , J ) ) ) 

QR0T-TEMP(K , J)/4. 2D+0 

C1-RH04*1 . 772  5D+01*QVIB*QR0T*Q3*DEXP  ( 5 . 950D+04/TEMP(K,  J)  ) 
C1-C1/(Q1**2*TEMP(K,J)**1.5) 

C2— RH04*7 . 801D+06*Q1*DEXP  ( 1 . 5 8D+05/TEMP  (K , J ) ) 
C2-C2/(Q2*TEMP(K,J)**1.5) 

ALPHA-0 . 5 D+0 
BETA-0 . 5 D+0 

162  F-BETA**2* ( 1 . D+0 -ALPHA) **2*C1+BETA- 1 . D+0 
FA— 2 . D+0*BETA**2*(1 . D+0-ALPHA)*Cl 
FB-2 . D+0*BETA* ( 1 . D+0 -ALPHA) **2*C1+1 . D+0 
G-ALPHA**2*BETA*C2+ALPHA- 1 . D+0 
GA-2 . D+0*ALPHA*BETA*C2+1 . D+0 
GB— ALPHA**  2 *C  2 
DENOM-FA*GB - FB*GA 
DA- ( - F*GB+G*FB ) /DENOM 
DB- ( - G*FA+F*GA) /DENOM 
ALPHA-ALPHA+DA 
BETA-BETA+DB 

IF((DABS(DA) .GT.l.D-05) .OR.  (DABS(DB) .GT.l.D-5))  GO  TO  162 
ALPH-RCON (K , 10 , J ) / (RCON (K , 10 , J )+RCON (K , 4 , J ) ) 

BET-(RCON(K, 10 , J)+RCON(K, 4 , J) )/(2 . D+0*RCON(K, 2 , J)  + 

* RCON(K, 10 , J)+RC0N(K,4, J) ) 

IF(IQ6 . EQ . 1)  GO  TO  1999 

BETO(K,  J)  — (BET**2/(1 .D+O-BET) )*( (1 . D+0 -BETA)/ (BETA**2) ) 

* *( (1 . D+0-ALPH)**2/(l . D+0 -ALPHA)** 2) 

1999  ALPO (K , J ) -BET* (ALPH**2/ ( 1 . D+0 - ALPH) ) 

* *( (1 . D+0 -ALPHA)/ (BETA*ALPHA**2) ) 

142  CONTINUE 

C BETA-BETA (Tt) 

IF(IQ6.EQ.l)  THEN 
DO  1122  K-3 , NXCON 
DO  1122  J— 1 , NPTS (K) 

IF ( J . EQ . NPTS (K) ) THEN 
BETN ( K , J ) — 0 . D+00 
GO  TO  1122 
ENDIF 
Ql-0 . D+0 
Q2-0.D+O 
Q3-0.D+0 

DO  1112  III— 1 , LI (3) 

1112  Ql— Q1+GIL(III , 3)*DEXP( -EPSIIL(III , 3 ) /TEMPO (K , J ) ) 

DO  1113  III— 1, LI (9) 

1113  Q2-Q2+GIL(III , 9)*DEXP( -EPSIIL(III , 9)/TEMPO(K, J) ) 

DO  1130  III— 1,LI(1) 

1130  Q3-Q3+GIL(III,l)*DEXP(-EPSIIL(III,l)/TEMPO(K,J)) 

RHOl-RCON (K, 3 , J)*l . 401D+01/6 . 023D+23 
RH02-RC0N(K, 9 , J)*l . 401D+01/6 . 023D+23 
RH03-RC0N(K, 1 , J)*2 . 802D+01/6 . 023D+23 
RH04-RH01+RH02+RH03 

QVIB-1. D+0/ ( 1 . D+0 - DEXP ( - 3 . 3 9D+03/TEMPO (K , J) ) ) 

QROT-TEMPO (K , J)/5 . 8D+0 

Cl— RH04*2 . 47  01D+01*QVIB*QROT*Q3*DEXP ( 1 . 135D+05/TEMPO(K, J) ) 
Cl-Cl/ (Ql**2*TEMPO (K , J)**l .5) 

C2=RH04*8 . 909D+06*Q1*DEXP(1. 69D+05/TEMPO(K, J) ) 

C2-C2/ (Q2*TEMPO (K, J)**l .5) 

ALPHA-0. 5 D+0 


BETA-0 . 5D+0 

1132  F-BETA**2* ( 1 . D+0 -ALPHA) **2*C1+BETA- 1 . D+0 
FA- - 2 . D+0*BETA**2* ( 1 . D+0 -ALPHA) *C1 
FB-2 . D+O+BETA* ( 1 . D+O -ALPHA) **2*C1+1 . D+O 
G-ALPHA**2*BETA*C2+ALPHA- 1 . D+0 
GA-2 . D+0*ALPHA*BETA*C2+1 . D+O 
GB-ALPHA**2*C2 
DENOM-FA*GB - FB*GA 
DA- ( - F*GB+G*FB) /DENOM 
DB- ( - G*FA+F*GA) /DENOM 
ALPHA-ALPHA+DA 
BETA-BETA+DB 

IF( (DABS(DA) .GT. l.D-05) .OR. (DABS(DB) .GT.l.D-5))  GO  TO  1132 
BET-(RCON(K, 9 , J)+RCON(K, 3 , J) )/(2 .D+0*RCON(K, 1 , J)+ 

* RCON(K, 9 , J)+RCON(K, 3 , J) ) 

ALPH-RCON (K , 9 , J)/(RCON(K, 9 , J)+RCON(K, 3 , J) ) 

BETN  (K,  J)— (BET**2/  (1  .D+O-BET)  )*(  ( 1.  D+0 -BETA) /(BETA**2)  ) 

* * ( ( 1 . D+0 - ALPH) **2/ ( 1 . D+0 -ALPHA) **2 ) 

1122  CONTINUE 

DO  1142  K-3 , NXCON 
DO  1142  J— 1,NPTS(K) 

IF( J . EQ . NPTS (K) ) THEN 
BETO (K , J ) -0 . D+00 
GO  TO  1142 
ENDIF 
Q1-0.D+0 
Q2-0 . D+0 
Q3-0.D+0 

DO  1152  III-1,LI(4) 

1152  Q1-Q1+GIL(III  ,4)*EXP(-EPSIIL(III , 4)/TEMPO(K,  J)  ) 

DO  1153  III— 1,LI(10) 

1153  Q2-Q2+GIL(III , 10)*DEXP( -EPSIIL(III , 10 ) /TEMPO (K,  J)  ) 

DO  1160  III-1,LI(2) 

1160  Q3-Q3+GIL(III,2)*DEXP(-EPSIIL(III,2)/TEMPO(K,J)) 

RHOl-RCON (K , 4 , J ) *1 . 600D+01/6 . 023D+23 
RH02— RCON(K, 10 , J)*l . 600D+01/6 . 023D+23 
RH03-RC0N(K, 2 , J)*3 . 200D+01/6 . 023D+23 
RH04-RH01+RH02+RH03 

QVIB— 1 . D+0/ ( 1 . D+0 - DEXP ( - 2 . 2 7D+03/TEMPO (K , J) ) ) 

QROT-TEMPO (K, J)/4.2D+0 

C1-RH04*1 .772  5D+01*QVIB*QROT*Q3*DEXP  ( 5 . 950D+04 /TEMPO  (K , J ) ) 
Cl-Cl/ (Ql**2*TEMPO (K , J ) **1 . 5 ) 

C2-RH04+7 . 801D+06*Q1*DEXP(1 . 58D+05/TEMPO(K, J) ) 

C2-C2/ (Q2+TEMPO (K, J)**l. 5) 

ALPHA-0 . 5 D+0 
BETA-0 . 5 D+0 

1162  F-BETA**2* ( 1 . D+0- ALPHA) **2*C1+BETA- 1 . D+0 
FA- - 2 . D+0*BETA**2* ( 1 . D+0 -ALPHA) *C1 
FB-2  . D+O+BETA*  ( 1 . D+0  - ALPHA)  **2*C1+1 . D+0 
G-ALPHA**  2 *BETA*C2+ALPHA - 1 . D+0 
GA-2 . D+0*ALPHA*BETA*C2+1 . D+0 
GB-ALPHA**2*C2 
DENOM-FA+GB - FB*GA 
DA- ( - F*GB+G*FB ) /DENOM 
DB- ( - G*FA+F*GA) /DENOM 
ALPHA-ALPHA+DA 
BETA-BETA+DB 

IF((DABS(DA) .GT. l.D-05) .OR. (DABS(DB) .GT.l.D-5))  GO  TO  1162 
BET-(RCON(K, 10 , J)+RCON(K, 4 , J) )/(2 . D+0*RCON(K, 2 , J)+ 

* RCON (K , 10 , J ) +RCON (K , 4 , J ) ) 


ALPH-RCON  (K , 10 , J ) / (RCON(K , 10 , J )+RCON  (K , 4 , J)  ) 
BETO(K,J)-(BET**2/(1.D+0-BET))*((1.D+0-BETA)/(BETA**2)) 

* * ( ( 1 . D+0  - ALPH)  **2/(1.  D+0  - ALPHA)  **2  ) 

1142  CONTINUE 
ENDIF 
END  IF 

C ABSORPTION  COEFFICIENTS 

DO  20  K-3 , NXCON 
DO  20  J— 1 ,NPTS (K) 

TT-TEMP(K,J)/168800.0 
IF(IQ6 . EQ. 1)  THEN 

TM-TEMPO (K , J ) /16 8800 . 0 
ELSE 
TM-TT 
ENDIF 

C IF( (IQ6  . EQ.  1)  .AND.  (TEMPO (K,J)  . LE. 8 .D+03) ) GO  TO  20 

C IF(TEMP(K,J) .LE.8.D+03)  GO  TO  20 
IF(IQ8 . EQ. 0)  THEN 
O-BETO(K.J) 

N-BETN(K.J) 

ELSE 

0-1 . D+0 
N-1.D+0 
ENDIF 

KAPPA(K,4 , J)-5 . D-19*0*RC0N(K,  2 , J)+5 . D-20*N*RCON(K,  1 , J) 

KAP (K , 4 . J ) -1 . 7D - 17*RCON (K , 3 , J ) *DEXP ( - . 246/TT) 

KA(K,4 , J)-0.D+0 

KAPPA (K,  3 , J)— 2 . D-  18*(N*RCON(K,  1 , J)+0*RC0N(K,  2 , J)  )+KAPPA(K,  4 , J) 

KAP(K,3,J)-2.1D-17*RCON(K,3,J)*DEXP(-.165/TT)+KAP(K,4,J) 

KA(K,3,J)-0.D+0 

KAPPA(K,  2 , J)— 5 . 1D-18*(N*RC0N(K,  1 , J)+0*RC0N(K,  2 , J)  )+KAPPA(K,  3 , J) 
KAP(K,2,J)-KAP(K,3,J) 

KA(K, 2 , J)-5 . ID- 18*RCON (K, 4 , J) 

KAPPA(K,  1 , J)— 2 .D-17*0*RC0N(K,2 , J)+4.D-16*N*RCON(K,  1,  J) 

C +KAPPA(K, 2 , J) 

KAP(K, 1 , J)-l . 1D-17*RC0N(K, 3 , J)+KAP(K, 2 , J) 

KA(K, 1, J)— KA(K, 2 , J) 

IF(IQ5.EQ.O)  THEN 
N-ALPN(K.J) 

O-ALPO(K.J) 

IF(IQ8 . EQ . 0)  THEN 
NN-BETN(K.J) 

00-BET0(K, J) 

ELSE 

NN-1 . D+0 
00-1 . D+0 
ENDIF 

KAPPA (K , 5 , J ) -7 . 7D- 17*  (NN*RCON(K,  1 . J )+00*RC0N  (K . 2 , J ) ) 

C *DEXP ( - . 4 9 /TT ) + 

C 2 . 6D- 17*(RCON(K, 3 , J)*N+RC0N(K,4 , J)*0)*DEXP( - . 723/TT) 

KAPPA (K , 6 , J ) -2 . D - 18*RC0N(K , 2 , J ) *00+6 . OD - 18* (RCON (K , 3 , J ) *N+ 

C RCON(K, 4 , J)*0)*DEXP(- . 379/TT)+KAPPA(K, 5 , J) 

IF(RC0N(K,7,J) .LE.l.D+OO)  THEN 
KAPPA (K, 7 , J)— KAPPA(K, 6 , J) 

GO  TO  909 
ENDIF 

KAPPA (K, 7 , J)-l . 2D03*( (RCON(K, 3 , J)*N+RCON (K, 4 , J)*0) /RCON(K, 7 , J) )* 
C DEXP( - . 489/TT)+KAPPA(K, 6 , J) 

909  KAPPA(K, 8 , J)-3 . 2D-17*(RCON(K, 3 , J)*N+RC0N(K,4, J)*0)*DEXP( - . 631/TT) 
C +KAPPA(K, 5 , J) 


0>\ 


ELSE 

KAPPA(K, 5 , J)-7 . 7D-17*(RCON(K,  1 , J)+RCON(K, 2 , J)  )*DEXP(-  .49/TT)+ 

C 2 . 6D-17*(RCON(K, 3 , J)+RC0N(K,4 , J) )*DEXP(- . 723/TT) 

KAPPA(K,  6 , J)-2 . D-18*RC0N(K, 2 , J)+6 ,OD-18*(RCON(K,  3 , J)+RC0N(K,4,  J)  ) 
C *DEXP(-.379/TT)+KAPPA(K,5,J) 

IF(RC0N(K,7,J) .LE.l.D+OO)  THEN 
KAPPA(K, 7 , J)-KAPPA(K, 6 , J) 

GO  TO  910 
ENDIF 

KAPPA(K,  7 , J)— 1 . 2D03*(  (RCON(K,  3 , J)+RC0N(K,4 , J) )/RCON(K,  7 , J)  )* 

C DEXP(-.489/TT)+KAPPA(K,6,J) 

910  KAPPA(K,  8 , J)-3 . 2D-17*(RCON(K, 3 , J)+RC0N(K,4, J) )*DEXP(- ,631/TT) 

C +KAPPA(K, 5 , J) 

ENDIF 

20  CONTINUE 

C PLANCK  FUNCTION 

DO  30  K-3 , NXCON 
DO  30  J-l.NPTS(K) 

TT-TEMP(K, J)/168800.0 
C IF(TEMP(K,J) .LE.8.D+03)  GO  TO  30 

BLACK- (TT*168 800 . )**4*5 . 6696D-12/3 . 1415927 
FF-15 .D+00/ (3 . 1415927**4) 

Xl-1 . /TT 

Bl-FF* (DEXP ( -XI ) * ( 6 . +6 . *Xl+3 . *X1**2+X1**3  )+ 

C DEXP ( - 2 . *X1 ) *0 . 5* ( . 75+1 . 5*X1+1 . 5*X1**2+X1**3 ) ) 

Xl-0 . 935/TT 

B2-FF* (DEXP ( -XI ) * ( 6 . +6 . *Xl+3 . *X1**2+X1**3 ) + 

C DEXP(-2 .*X1)*0 . 5*( .75+1 . 5*X1+1. 5*X1**2+X1**3) ) 

Xl-0 . 835/TT 

B 3-FF* ( DEXP ( -XI ) * ( 6 . +6 . *Xl+3 . *X1**2+X1**3 ) + 

C DEXP ( - 2 . *X1 ) *0 . 5* ( . 75+1 . 5*X1+1 . 5*X1**2+X1**3 ) ) 

Xl-0 . 754/TT 

B4-FF* (DEXP ( -XI) * ( 6 . +6 . *Xl+3 . *X1**2+X1**3 ) + 

C DEXP( -2 . *X1)*0 . 5*( .75+1 . 5*X1+1 . 5*X1**2+X1**3) ) 

Xl-0 . 473/TT 

B6-FF*(DEXP(-X1)*(6 .+6 ,*Xl+3 . *X1**2+X1**3)+ 

C DEXP ( - 2 . *X1 ) *0 . 5* ( . 75+1 . 5*X1+1 . 5*X1**2+X1**3 ) ) 

Xl-0 . 213/TT 

B8-FF* ( DEXP ( -XI ) * ( 6 . +6 . *Xl+3 . *X1**2+X1**3 ) + 

C DEXP ( - 2 . *X1 ) *0 . 5* ( . 7 5+1 . 5*X1+1 . 5*X1**2+X1**3 ) ) 

B8-1-B8 

B2-B2-B1 

B3-B3-B2 

B4-B4-B3 

B6-B6-B4 

B5-1-B8-B6-B4-B3-B2-B1 
B(K,1,J)=BLACK*B1 
B(K, 2 , J)-BLACK*B2 
B(K, 3 , J)— BLACK*B3 
B ( K , 4 , J ) -BLACK*B4 
B(K, 6 , J)— BLACK*B6 

B (K , 7 , J ) -BLACK*2 . 4D - 21*RCON(K , 7 , J )*B6*DEXP ( . 162/TT) 

B(K, 8 , J)— BLACK*B8 
B(K , 5 , J)-BLACK*B5 
30  CONTINUE 

C TAU'S 

DO  100  K-3, NXCON 
DO  100  1-1,8 
IF(I .GT.4)  THEN 

OPTL(K, I , 1)-KAPPA(K, I , 1)*DABS (Y(K, 1) -YBDY(K) ) 


ELSE 

0PTL(K,I,1)-(KAPPA(K,I,1)+KAP(K,I,1)+KA(K,I,1)) 

C *DABS(Y(K,1)-YBDY(K)) 

ENDIF 

DO  100  J-2 ,NPTS(K) 

IF(I.GT.4)  THEN 

K11-KAPPA(K, I , J)+KAPPA(K, I , J-l) 

ELSE 

K11-KAPPA(K,  I , J)+KAP(K, I , J)+KAPPA(K,  I , J-1)+KAP(K,  I , J-l) 
C +KA(K, I , J)+KA(K, I , J-l) 

ENDIF 

OPTL(K,I,J)-OPTL(K,I,J-l)+(5.D-l*(Kll)*DABS(Y(K,J-l) 

C -Y(K, J) ) ) 

100  CONTINUE 

C QRW 

DO  200  K-3.NXC0N 
WRITE(*,102)  XPST(K) 

WRITE (8, 102)  XPST(K) 

102  FORMAT(///, ' AT  X - '.D11.4) 

WQR-0.0 
DO  180  1-1,8 

CALL  FEI (Ell , E2I , E3I , OPTL(K, 1,1)) 

EOLD-E2I 

JIN-1 

IF(I.GT.4)  THEN 

Kll— KAPPA(K, I , 1)*B(K, I , 1) 

ELSE 

IF(IQS.EQ.l)  THEN 
ALPN(K, 1)— 1.D+0 
ALP0(K,1)— l.D+O 
ENDIF 

K11-KAPPA(K,  1 , 1)*B(K,  1 , 1)+KAP(K,  1 , 1)*B(K, I , 1)*ALPN(K,  1)  + 
C KA(K, I , 1)*B(K, I , 1)*ALP0(K, 1) 

ENDIF 

SUM-3 . 1415927*E0LD*K11*DABS (Y(K, 1) -YBDY(K) ) 

IF(IQ9 . EQ. 0)  WRITE(8 , 2221)  JIN, I, SUM 
DO  150  J-2 ,NPTS(K) 

IF(I . GT. 4)  THEN 

K11-KAPPA(K , I , J ) *B (K , I , J ) 

K22-KAPPA(K, I,J-1)*B(K,I,J-1) 

ELSE 

IF(IQS.EQ.l)  THEN 
ALPN(K,J) -l.D+O 
ALPO(K,J)— l.D+O 
ENDIF 

K11-KAPPA(K,I , J)*B(K, I , J)+KAP(K, I , J)*B(K, I , J)*ALPN(K, J)+ 
C KA(K,I,J)*B(K,I,J)*ALPO(K,J) 

K22— KAPPA(K, I , J-1)*B(K, I , J-l)+ 

C KAP(K,I,J-1)*B(K,I,J-1)*ALPN(K,J-1)+ 

C KA(K,I,J-1)*B(K,I,J-1)*ALP0(K,J-1) 

ENDIF 

Z— OPTL(K, I , J) 

CALL  FEI (Ell , E2I , E3I , Z) 

STSUM-3 . 14159*(Kll*E2I+K22*EOLD)*DABS (Y(K, J-l) -Y(K, J) ) 
IF(IQ9 . EQ. 0)  THEN 
WRITE(8 , 2221)  J,I,STSUM 

2221  FORMAT (IX, ' AT  J -',12,'  BAND  ',12,'  QR  -' ,D11.4) 

ENDIF 

145  SUM-SUM+STSUM 
E0LD-E2I 


oo  o o o o n o 


150  CONTINUE 

WRITE (*,103)  1 , SUM 
WRITE (8, 103)  I, SUM 

103  FORMAT(/,'  FOR  BAND  ',12/  QR  - '.Dll. A,'  WATTS/SQ.CM.') 

WQR-WQR+SUM 
180  CONTINUE 

WRITE (*,101)  WQR 
WRITE (8, 101)  WQR 

101  F0RMAT(/'  TOTAL  QR  - ' ,D11.4, ' WATTS/SQ. CM. * ) 

200  CONTINUE 
RETURN 
END 


SUBROUTINE  FEI (Ell , E2I , E3I , Z) 

IMPLICIT  REAL*8(A-H,0-Z) 

COMMON  /RADI/  RRHO(30 , 30) , Y(30 , 30) , YBDY(30) 
COMMON  /RAD3/  B(30,8,30) 

COMMON  /RAD5/  OPTL(30 , 8 , 30) 

REAL  OPTL,XPST,Y,YBDY, TEMPO, TEMP, Z 
REAL  ALPN , ALPO , B , BETN , BETO 
CALL  EXPI (Z , Ell , AUX) 

E2I-DEXP(-Z)-Z*E1I 
E3I-(DEXP(-Z)-Z*E2I)/2.0 
E2 I-DEXP ( - Z*DSQRT ( 3 . D+00) ) 

RETURN 

END 


C 

SUBROUTINE  EXPI (X , RES , AUX) 

IMPLICIT  REAL*8(A-H,0-Z) 

COMMON  /RADI/  RRH0(30 ,30) ,Y(30 , 30) , YBDY(30) 

COMMON  /RAD3/  B(30,8,30) 

COMMON  /RAD5/  OPTL(30 , 8 , 30) 

C REAL  OPTL  ,XPST,Y,YBDY, TEMPO, TEMP, Z 

C REAL  ALPN, ALPO, B, BETN, BETO 

IF(X- 1 . ) 2,1,1 

1 YY-1 . /X 

AUX— 1 . -YY*( ( (YY+3 . 377358 )*YY+2 . 052156)*YY+2 . 70947 9D- 01) /( ( ( (YY* 

Cl . 072553+5 . 716943)*YY+6 . 945239)*YY+2 . 593888)*YY+2 . 709496D-01) 
RES-AUX*YY*DEXP( -X) 

RETURN 

2 IF(X+3 . ) 6,6,3 

3 AUX-( ( ( ( ( ( (7 . 122452D-7*X-1. 766345D-6)*X+2 . 928433D-5)*X-2. 335379D-4 
C)*X+1 . 664156D- 3)*X-1 . 041576D-2)*X+5 . 555682D-2)*X-2 . 500001D-1)*X 
C+9 . 999999D-1 

RES— l.D+30 
IF(X)  4,5,4 

4 RES-X*AUX-DLOG(ABS(X) ) -5 . 772157D-1 

5 RETURN 

6 IF(X+9 . ) 8,8,7 

7 AUX— 1 . - ( ( ( (5 . 176245D-2*X+3 . 061037)*X+3 . 243655D+l)*X+2 . 244234D+2)*X 
C+2 . 486697D+2)/ ( ( ( (X+3 . 995161)*X+3 . 893944D+l)*X+2 . 263818D+1)*X 

C+l . 807837D+2) 

GO  TO  9 

8 YY-9 . /X 

AUX-1 . -YY* ( ( (YY+7 . 659824D-l)*YY-7 . 271015D-1)*YY-1 ,080693)/((( (YY 
C*2. 518750+1. 122927D+l)*YY+5.921405)*YY-8.666702)*YY-9. 724216) 


RES-AUX*DEXP ( -X) /X 
RETURN 
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PROGRAM  AFEM  - ( IBM-3090,  "WYLBUR"  VERSION  ) 

AN  INVERSE  HYPERSONIC  FLOW  SOLUTION  FOR  AN  AFE/AOT V BODY  IN 
CHEMICAL  NONEQUILIBRIUM  USING  COUPLED  VIBRATION-DISSOCIATION  MODELS, 
SHOCK  JUMP  APPROXIMATIONS,  ELECTRON  TEMPERATURE  MODELING,  AND 
UNCOUPLED  RADIANT  HEAT  TRANSFER  USING  A METHOD  DERIVED  BY  S.MASLEN 

BASED  ON  AN  ORIGINAL  PROGRAM  BY  B.L.  WEIGEL  FOR  WILLIAM  L.  GROSE 
VIRGINIA  POLYTECHNIC  INSTITUTE 

MAJOR  PROGRAM  REVISIONS  BY  G.BOBSKILL,  R . GREENDYKE , AND  L. CARLSON 
TEXAS  A&M  UNIVERSITY 


CALITH  : INTEGRATION  ROUTINE  BY  CHARLES  E.  TREANOR 
THE  NUMERICAL  INTEGRATION  ALGORITHM  USED  IS  FOUND  IN  A METHOD 
FOR  THE  NUMERICAL  INTEGRATION  OF  COUPLED  FIRST  ORDER 
DIFFERENTIAL  EQUATIONS  WITH  GREATLY  DIFFERENT  TIME  CONSTANTS 

FOFE  - EVALUATE  E BY  NEWTON  ITERATION  METHOD 

FOFTS1  - EVALUATE  TS  BY  NEWTON  ITERATION  METHOD,  CHEMISTRY  FROZEN 
FOFT23  - FOFTS1  WITH  N2  FROZEN,  02  DISSOCIATING  OR  BOTH  N2  & 02  DISS. 
FTLUP  - INTERPOLATION  ROUTINE 

DATA  FILES 


UNIT  5 IS  USED  TO  READ  DATA  FROM  FILE  SCREEN 

UNIT  7 IS  USED  TO  READ  DATA  FROM  INPUT  DATA  FILE 

UNIT  8 IS  USED  FOR  THE  OUTPUT  DATA  FILE 

UNIT  9 IS  USED  TO  STORE  VIBRATIONAL  ENERGY  DATA  AT  THE  SHOCK  (FORMATTED) 

UNIT  10  IS  USED  TO  STORE  ALL  STAGNATION  QUANTITIES 

UNIT  11  IS  USED  TO  STORE  ALL  EVIS  DATA  FOR  COMPUTATIONAL  PURPOSES 

UNIT  12  IS  USED  TO  STORE  ALL  PRESSURE  DATA 

UNIT  13  IS  USED  TO  STORE  ALL  DPDX  DATA 

UNIT  14  IS  USED  TO  STORE  QUANTITIES  FOR  PHYSICAL  SPACE  CALCULATIONS 
UNIT  15  IS  USED  TO  STORE  ALL  WARNINGS  DURING  PROGRAM  EXECUTION 

INPUT-NAMELIST 


DELX  * INCREMENT  ALONG  SHOCK  , cm 

ZSTERM  * LENGTH  OF  SYMMETRY  AXIS  , Z , cm 

IMAX  = MAX.  NO.  OF  I-S  SPECIES  , LESS  THAN  OR  EQUAL  TO  25 

JMAX  * MAX.  NO.  OF  J-S  REACTIONS  , LESS  THAN  OR  EQUAL  TO  50 

MJ  « CODE  INDICATING  WHICH  SPECIES  , I , TD  USE  TO  CALCULATE 

COUPLING  FACTOR,  PHI  SUB  J , FOR  REACTION  J 
M * 1 FOR  VIBRATIONAL  NON-EQUILIBRIUM 

* 0 FOR  VIBRATIONAL  EQUILIBRIUM 

R = UNIVERSAL  GAS  CONSTANT  , erg/(mole-K) 

GAMMA  = RATIO  OF  SPECIFIC  HEATS 

Cl INF  = FREE  STREAM  MASS  FRACTION  FOR  EACH  SPECIES 

PINF  = FREE  STREAM  PRESSURE  , dynes/cm**2 

TINF  * FREE  STREAM  TEMPERATURE  , K 

VINF  * FREE  STREAM  VELOCITY  , cm/sec 

MUI  ■=  MOLECULAR  WT . FOR  EACH  SPECIES  , gm/mole 

THETAI  = CHARACTERI S I C VIBRATIONAL  TEMPERATURE  , K 

DGENI  = FUDGE  FACTOR  TO  PERMIT  APPROXIMATING  POLYATOMIC  MOLECULE 
BY  A DIATOMIC  MOLECULE 
FI  =0  FOR  MONATOMIC  SPECIES 

= 1 FOR  ALL  OTHERS 

DELHI  = HEAT  OF  FORMATION  , ergs/mole 
DELI  = DISSOCIATION  ENERGY  OF  SPECIES  , K 
EVI  = VIBRATIONAL  ENERGY  OF  SPECIES  , ergs/g 

B I = 3/2*1n(2*PI*Mi*k/h**2)  + ln(k)  + FI ( I )*1 n(THETAI (Rotat ional ) ) 

+ ln(GIL(I,1))  FOR  EACH  SPECIE  I 

LI  = NUMBER  OF  ELECTRONIC  LEVELS  FOR  EACH  SPECIES  ( LI.LE.20  ) 

GIL  * DEGENERACY  OF  L-TH  ELECTRONIC  LEVEL  FOR  I-TH  SPECIES 

EPS  1 1 L = L-TH  ELECTRONIC  ENERGY  LEVEL  FOR  I-TH  SPECIES  , K 
AJ  = FREQUENCY  FACTOR  IN  ARRENI US  TYPE  RATE  EQN . 

BJ  * TEMPERATURE  EXPONENT  IN  ARRENI US  TYPE  EQN. 

EJ  * ACTIVATION  ENERGY  IN  ARRENIUS  TYPE  EQN. 

DIRECT  = DIRECTION  OF  THE  REACTION  ( FORW.  = 1.0  , BACK.  = 2.0  ) 

A I J = FACTOR  TO  ALLOW  USE  OF  GENERAL  SPECIES  IN  REACTION  EQNS . 

i.e.  ( N2  + M = 2N  + M),  AIJ  = 1.0  OR  (N2  + 02  = 2N0).  AIJ  = 0.0 
NUIJ  = STOICHIOMETRIC  COEFFICIENTS  OF  I-TH  REACTANT  IN  J-TH  REACTION 

NUPIJ  * STOICHIOMETRIC  COEFFICIENT  FOR  I-TH  PRODUCT  IN  J-TH  REACTION 

ALP  I K = FACTORS  IN  EQN.  FOR  VIBRATIONAL  RELAXATION  TIME 
BETAIK  = FACTORS  IN  EQN.  FOR  VIBRATIONAL  RELAXATION  TIME 

5 on 


SIGIK  « FACTORS  IN  EON.  FOR  VIBRATIONAL  RELAXATION  TIME 
NIP  ■ NUMBER  OF  VIBRATIONAL  LEVELS  FOR  ANHARMONIC  OSCILLATOR  . K 

UP  » CHARACTERISTIC  PROBABILITY  TEMPERATURE  . K 

WE  « CONST.  USED  TO  COMPUTE  ANHARMONIC  OSCILLATOR  . K 

WEXE  » CONST.  USED  TO  COMPUTE  ANHARMONIC  OSCILLATOR  , K 

WEYE  ■ CONST.  USED  TO  COMPUTE  ANHARMONIC  OSCILLATOR  , K 

WEZE  « CONST.  USED  TO  COMPUTE  ANHARMONIC  OSCILLATOR  . K 

XI  » INITIAL  COMPUTING  INTERVAL  . .0001220703125  UNLESS  INPUT  , cm 

ELE 1 « ( 2* IMAX  + 1)  VALUES  USED  BY  INTEGRATION  SCHEME 

NORMALLY  0. 1,0.5,  OR  .05 

ELE2  « (2*IMAX  + 1)  VALUES  USED  BY  INTEGRATION  SCHEME 
NORMALLY  .05..1,  OR  .01  AND  . LT.  ELE 1 
XPST  ■ 99  OR  LESS  Xs  AT  WHICH  PHYSICAL  SPACE  CALCULATIONS  ARE 

DESIRED.  THEY  MUST  BE  MULTIPLES  OF  DELX  IN  ORDER  TO  HAVE 
RS . COST , ZS , AND  SINT  VALUES  AND  LAST  MUST  BE  .GT.  X AT 
ZSTERM.  THEREFORE,  XPST(NXPST)  SET  « X AT  ZSTERM  + 100.0 
IN  PROGRAM.  XPST ( 1 ) MAY  NOT  BE  0.0  . THEREFORE,  SET 
XPST ( 1 ) * DELX  IN  PROGRAM 

NXPST  « NUMBER  OF  X-S  AT  WHICH  PHYSICAL  SPACE  CALCULATIONS  ARE 
DESIRED 

CIMAX  « MAX.  CJ  OR  COMPUTING  INTERVAL  0.0625  UNLESS  INPUT  OTHERWISE 
HCHCKT  » CONTROL  ON  SIZE  OF  COMPUTING  INTERVAL  IN  CHECK 
I F ( ABS(HPREV  - H )/H . GT . HCHECK ) REDUCE  INTERVAL 
TCHCKT  « CONTROL  ON  SIZE  OF  COMPUTING  INTERVAL  IN  CHECK 
I F ( ABS (TPREV  - T )/T . GT . TCHECK)  REDUCE  INTERVAL 
PHMAX  - CONTROL  ON  COMPUTING  INTERVAL  . LE . 65.0 
IPF  ■ OUTPUT  PRINT  FREQUENCY 

STOPS 


STOP  1 INCORRECT  INPUT 

STOP  2 IN  MAIN  WHEN  NXPST  IS  . LE  . 2 

STOP  13  IN  SHOCKG 

STOP  30  IN  CHECK  WHEN  COMPUTING  INTERVAL  . LT . I.OE-15 

STOP  66  IN  BASIC  WHEN  NO  CONVERGENCE  ON  E ITERATION  (FOFE) 

STOP  301  IN  MAIN  FOR  ERROR  IN  XPST  ARRAY  OR  IZTERM  . GT . 500 

STOP  321  IN  MAIN  WHEN  NO  CONVERGENCE  ON  TS  ITERATION  ( FOFTS ) 

STOP  663  IN  MAIN  WHEN  X . NE . VARI(IPSI) 

STOP  665  IN  MAIN  AFTER  AN  INTEGRATION  ATTEMPT 

STOP  670  IN  MAIN  WHEN  A Cl  NEGATIVE 

IMPLICIT  REAL*8(A-H.0-Z) 

COMMON  /A  1/  TE1.TE2.M, IX, IMAX, IPSI, MODEL 
COMMON  / A2/  P( 500) , DPDX(500) , VARI ( 500) 

FOLLOWING  7 VARIABLES  DIMENSIONED  BY  IMAX 
COMMON  /A3/  EVIINF(25),THETAI(25),MUI(25),FI(25),DELHI(25), 

* CIINF(25),LI(25) 

COMMON  /A4/  R.MUINF, DELTA, LAMSQ , OMEGSQ . OMEGA, MU, T.U.TINF 

FOLLOWING  2 VARIABLES  DIMENSIONED  BY  (LMAX  IN  LI, IMAX) 
COMMON  /A5/  EPSI IL( 20, 25 ) , GIL(20, 25 ) , CIO ( 200, 50) 

COMMON  / A6/  VAR ( 52 ) , CUVAR( 52 ) ,DER(51) 

FOLLOWING  4 VARIABLES  DIMENSIONED  BY  JMAX 
COMMON  /A7/  MJ(50),EJ(50),AJ(50),BJ(50),DIRECT(50) 

FOLLOWING  3 VARIABLES  DIMENSIONED  BY  IMAX 
COMMON  / A8/  TVI ( 25 ) , DGENI ( 25 ) , BI ( 25 ) . NI ( 25 ) 

EVIS(IMAX) 

COMMON  /A9/  EVIS(25),XPST( 100) 

FOLLOWING  3 VARIABLES  DIMENSIONED  BY  ( IMAX+ 1 , UMAX ) OR  (IMAX, JMAX) 
COMMON  /A  10/  NUI J ( 26 , 50) , AI J( 25 , 50) , NUPI J( 25 , 50) 

FOLLOWING  3 VARIABLES  DIMENSIONED  BY  (IMAX, JMAX) 
COMMON  /All/  SIGIK(25,25),ALPIK(25,25),BETAIK(25,25) 

COMMON  /A  1 2/  SINTM( 1500) , COSTM( 1 500) , RSM( 1 500) , RCM( 1 500) , X 1 ( 1500) 

* , ZSM( 1 500) 

COMMON  /A  1 3/  SP, TS. DELX. ZSTERM, IZTERM, NSR. MW 

COMMON  /A  14/  EINF.PINF, RHOINF , VINF , E , JMAX , KEY I NT , RHO , HSTAG 

COMMON  /A 15/  PFTL,KITR1,NIP(25), UP( 25 ) 

COMMON  /A16/  WE(25),WEXE(25),WEYE(25).WEZE(25), IUNEG 
COMMON  /A  1 7/  ELB, SPEC, CJ, TPREV, HPREV , HCHECK , TCHECK 
COMMON  /A  18/  ITNEG , I EXP 
COMMON  /A  19/  ELEK51 ) , ELE2(51  ) ,NERR 

COMMON  /RAD/  RCON( 100, 10,40) , RRHO( 100, 40) . TEMP ( 100, 40) 

* ,TSTAG,Y( 100,40) ,NXCON,NPTS( 100) 

COMMON  /RADC/  YBDY ( 100) , B( 100 , 8 , 40) , OPTL( 100, 8 . 40) 

COMMON  /RADO/  TEMPO ( 100, 40) , ALPN( 100 , 40) , ALPO( 100 , 40) 

COMMON  /RADOL/  BETN( 100, 40)  , BETO ( 100, 40) 

COMMON  /PLOT/  XSTR 1 (2000) . ZSTR 1 ( 2000) . RSTR 1 ( 2000) 

DELI ( IMAX ) 

DIMENSION  DELI(25) ,PREC(25) 

DIMENSION  RUT ( 200) , PSISTG( 200) 

DIMENSION  CIG(25, 11),EIG(25, 11) 


DIMENSION  PSIG( 1 1 ) ,TG( 1 1 ) ,HG( 1 1 ) ,CIT( 1 1 ) , EIT( 11 ) , EG( 1 1 ) 

CM( IMAX) , Cl ( IMAX ) , EVI ( IMAX) 

DIMENSION  CM (25) , Cl (25) , EVI (25) 

EQUIVALENCE  ( VAR( 1 ) , XVAR) , ( VAR(2) , H) , (VAR(3) , Cl ( 1 ) ) 

REAL'S  MUI , MUINF , MU, MINF.MINFSQ, LAMBDA. LAMSQ 
CHARACTER*30  INFILE, OUTFL 1 , OUTFL2 
CHARACTER*30  SPECIE ( 25 ) , REACT( 50) 

CHARACTER'80  INDATA 


READ  INPUT  FROM  FILE  SCREEN 

READ ( 5 , 15 ) INDATA 
READ( 5 , 15 ) INDATA 
READ( 5 , 15 ) INDATA 
READ ( 5 , 15 ) INDATA 
READ(5 , 15 ) INDATA 
R£AD( 5 ,15)  INDATA 
READ( 5,15)  INDATA 
READ( 5 , 15 ) INDATA 
READ( 5 , 15 ) INDATA 
READ( 5 , 15 ) INDATA 
READ(5 ,15)  INDATA 
READ( 5 , 15 ) INDATA 
READ( 5 , 15 ) INDATA 
READ( 5 , 15 ) INDATA 
READ( 5 , 15 ) INDATA 
READ( 5 , 15 ) INDATA 
READ(5 , 15 ) INDATA 
READ(5 , 15 ) INDATA 
READ( 5 , 15 ) INDATA 
READ( 5 , 15 ) INDATA 
READ( 5,15)  INDATA 
READ(5 , 15)  INDATA 
READ( 5 , 15 ) INDATA 
READ ( 5 , 15 ) INDATA 
READ(5 , 15)  INDATA 
READ( 5 , 15 ) INDATA 
READ( 5 , 15 ) INDATA 
READ ( 5 , 15 ) INDATA 
READ(5 , 15 ) INDATA 
READ( 5 , 15 ) INDATA 
READ( 5 , 15 ) INDATA 
READ( 5 , 15 ) INDATA 
READ( 5 , 15 ) INDATA 
READ( 5 ,15)  INDATA 
READ( 5 , 15 ) INDATA 
READ( 5 , 15 ) INDATA 
READ(5 , 15 ) INDATA 
READ( 5 ,15)  INDATA 
READ( 5 , 15 ) INDATA 

READ( 5 , * ) IPF.M.NSR, IANS, MW, MODEL, IQ3, IQ1 , IQ2 , IQ4 , IQ5 , IQ7 , IQ6 
* .IQ8.IQ9.IQ10 

READ ( 5 , * ) IS1.IS2.IS3, I S4.IS5.IS6 
READ(5, *)  XI ,DELX,ZSTERM,VINF,PINF,TINF 
READ(5, *)  IS7 
FORMAT (A80) 


NSR1  - NSR  + 1 

NSRM1  « NSR  - 1 

NERR  « 0 

ITNEG  « 0 

I EXP  « 0 

NEG  * 0 

IUNEG  = 0 

DO  21  I « 1,52 

VAR ( I ) =0.0 

CUVAR(I)  « 0.0 

IF  (I .EQ.52)  GO  TO  21 

DER(I)  = 0.0 

ELEI(I)  = 0.0 

ELE2( I ) = 0.0 

CONTINUE 

READ  INPUT 

READ(7, * ) IMAX, JMAX.R, GAMMA 

READ ( 7 , * ) NXPST , CIMAX , PHMAX , TCHCKT , HCHCKT 

IF  (NXPST. EQ. 20)  NXCON  = NXPST  - 1 
IF  (NXPST. EQ. 40)  NXCON  = NXPST  - 2 


DO  42  I = 1 , IMAX 

READ( 7 , * ) THETAI ( I ) , MUI ( I ) , FI ( I ) , DELHI ( I ) . Cl INF ( I ) , LI ( I ) , DGENI ( I ) 
* ,DELI(I),EVI(I),BI(I) 


DO  45  d * 1 , JMAX.2 

45  READ(7 , * ) MJ( J ) . AJ( J) . BJ( d ) . Ed( J) ,DIRECT( J ) 

DO  48  d ■ 2. JMAX.2 
48  READ( 7 , * ) MJ( J ) .DIRECT ( J) 

IMAX21  - 2*IMAX  + 1 
DO  51  I - 1.IMAX21 
51  READ(7 , * ) ELE 1(1), ELE2( I ) 

DO  54  I ■ 1 , I MAX 

54  READ( 7 , * ) (AIJ(I.J).J  - 1.JMAX) 

DO  57  d * 1.JMAX 

57  READ(7 , * ) (NUIJ(I.d).I  ■ 1.IMAX+1) 

DO  60  d « 1.JMAX 

60  READ(7 , * ) (NUPIJ(I,  J) . I - 1.IMAX) 

DO  63  I « 1 , IMAX 

63  READ( 7 , * ) ( ALPIK( J , I ) , d * 1.IMAX) 

DO  66  I - 1 , IMAX 

66  READ(7 , * ) (BETAIK( J . I ) . d * 1.IMAX) 

DO  69  I * 1 , IMAX 

69  READ(7 . * ) ( SIGIK( d . I ) . d » 1.IMAX) 

DO  72  I » 1.XMAX 
LI  I » LI ( I ) 

72  READ(7 , * ) (GIL(L.I).L  » 1.LII) 

DO  75  I ■ 1 , IMAX 
LI I - LI ( I ) 

75  READ( 7 , * ) ( EPSI I L( L , I ) . L - 1.LII) 

IF  (IANS.EO. 1)  THEN 

NXPST  « 4 

XPST(1)  » ( I S3  - NSR ) *DELX 
XPST ( 2 ) « ( IS4  - NSR)*DELX 
XPST (3)  » (IS5  - NSR)*DELX 
XPST (4 ) = (IS6  - NSR ) *DELX 
GO  TO  78 
END  IF 

DO  76  I « 1, NXPST 
NPTS(I)  « I 

76  XPST ( I ) « DELX*I 
78  DO  80  I « 1 . IMAX 

80  READ(7 , * ) NIP(I),UP(I),WE(I),WEXE(I),WEYE(I),WEZE(I) 

IMAXP2  * IMAX  + 2 

C SUM  OF  Cl INF  SHOULD  BE  1.0 

SUM  « 0.0 
DO  81  I » 1 . IMAX 

81  SUM  « SUM  + CIINF(I) 

IF  (SUM. EO. 1 .0)  GO  TO  85 
WRITE ( 15,82)  SUM 

82  FORMAT( IX, 'SUM  OF  CIINF(I)  SHOULD  BE  1:  IT  IS  - '.Ell. 4,'  STOP  1') 
STOP 

C STOP  1 

85  HCHECK  « HCHCKT 
TCHECK  - TCHCKT 

C READ  IN  AND  WRITE  OUT  SPECIES  AND  REACTIONS 

DO  88  I > 1, IMAX 
88  READ(7 , 90)  SPECIE(I) 

90  FORMAT ( A30) 

WRITE ( 8 , 95 ) 

95  FORMAT (//) 

WRITE(8, 100) 

100  FORMAT( 14X, 'SPECIES'/) 

DO  110  I « 1 , IMAX 
105  FORMATC IX, 15, 1 1X.A30) 

110  WRITE(8 , 105)  I.SPECIE(I) 

WRITE (8 , 95 ) 

DO  112  I ■ l.dMAX 
112  READ(7 , 90)  REACT ( I ) 

WRITE(8, 115) 

115  FORMAT( 14X, 'REACTIONS'/) 

DO  120  I a l.dMAX 
120  WRITE ( 8 , 125)  I.REACT(I) 

125  FORMAT (1X,I5,8X,A30) 

WRITE ( 8 , 95 ) 

REWIND  7 

C STORE  PRELIMINARY  INFO.  FOR  DISSPLA 

WRITE ( 69 , * ) IMAX, JMAX, MODEL, VINF , PINF , TINF 

C PRINT  INPUT 

WRITE ( 8 , 135)  HCHCKT, TCHCKT, PHMAX 

135  FORMAT( IX, 'HCHCKT  = ', E 1 1 . 4 , 4X ,' TCHCKT  = ' , E 1 1 . 4 , 4X , ' PHMAX  = ', 

* Ell. 4/) 

WRITE ( 8 , 140)  XI .CIMAX, NXPST 

140  FORMAT ( IX , ' XI  = ' , E 1 1 . 4 , 8X , ' CIMAX  = ' , E 1 1 . 4 , 5X , ' NXPST  = ',13//) 

DO  141  I = 1.IMAX21 

<ri° 


141  WRITE(8,142)  I , ELE 1 ( I ) , I . ELE2 ( I ) 

142  FORMAT (1X,'ELE1(',I2,')  - ' , E 1 1 . 4 . 5X , ' ELE2( '.12 . ' ) - '.Eli. 4) 
WRITE ( 8 , 95  ) 

DO  143  I - 1.NXPST 

143  WRITE (8 , 144)  I.XPST(I) 

144  FORMAT (IX.'XPSTC'.IS,')  « '.Ell. 4) 

WRITE(8 ,95) 

WRITE(8, 145)  I MAX , JMAX  , M 

145  FORMAT( IX, 'IMAX  - ' , 12 , 1 IX , ' JMAX  * '.I2,13X.'M  - '.12/) 

WRITE (8, 150)  DELX , 2STERM , IPF , R , PINF . TINF , VINF , GAMMA 

150  FORMAT( IX, 'DELX  * ' , E 1 1 . 4 , 2X , 'ZSTERM  ■ '.E11.4.2X, 

*' PRINT  FREQ.  ■ ',I3,3X,'R  « ' , E 1 1 . 4 , // . IX . ' PINF  - '.Eli. 4. 

*2X , 'TINF  » '.Ell. 4, 4X, 'VINF  ■ ' , E 1 1 . 4 . 2X , 'GAMMA  = '.E9.3//) 

WRITE ( 8 , 155) 

155  FORMAT ( 16X, 'Mill ' ,8X, 'THETAI ' ,7X, 'DGENI ' , 10X, 'FI ' ,9X, 'DELHI'/) 

DO  157  I « 1 , IMAX 

157  WRITE ( 8 , 160)  I , MUI ( I ) , THETAI ( I ) , DGENI ( I ) . FI ( I ) , DELHI  ( I ) 

160  FORMAT ( IX, I2,8X,5(E1 1 . 4 , 2X ) ) 

WRITE ( 8 , 95 ) 

WRITE(8, 161) 

161  FORMAT ( 16X , 'DELI' ,8X, 'Cl INF ' , 9X . ' EVI ' , 10X, ' LI ' , 1 IX , 'BI '/) 

DO  163  I - 1 , IMAX 

163  WRITE ( 8 , 164 ) I , DELI ( I ) , Cl INF ( I ) . EVI ( I ) . LI ( I ) , BI ( I ) 

164  FORMAT ( IX , 12 ,8X, 3( E 1 1 . 4 , 2X) , 3X , 13 , 7X, E 1 1 . 4 ) 

WRITE ( 8 , 95 ) 

WRITE ( 8 , 165) 

165  FORMAT ( 8X , ' NIP ' . 9X , 'UP ' . 10X , ' WE ' , 10X , 'WEXE' ,9X, 'WEYE' , 8X , 'WEZE'/) 
DO  167  I - 1 , IMAX 

166  FORMAT ( IX  . 12 , 5X  , 13 , 4X  , E 10 . 4 , 2X  , E 10 . 4 , 3X  . E 10. 4 , 3X  , E 10 . 4 , 2X  , E 10. 4 ) 

167  WRITE ( 8 , 166 ) I , NIP( I ) . UP( I ) , WE ( I ) . WEXE ( I ) , WEYE ( I ) , WEZE ( I ) 

WRITE (8,95) 

WRITE ( 8 , 170) 

170  FORMAT ( 12X , ' MO ' , 9X , ' A J ' , 14X , 'Bd ' , 1 5X , ' E J ' , 10X , 'DIRECTION' ,/, 

* 69X, 'F=1 ,B=2'/) 

DO  180  J - 1 , JMAX. 2 

175  FORMAT ( IX. 12 , 2X , 18 . 3(2X , E 1 5 . 6 ) , 5X, F5 . 2) 

180  WRITE (8 , 175)  J , MJ( J ). AJ( J ). BJ( J ), EJ( J ), DIRECT ( J ) 

WRITE (8 , 95 ) 

WRITE ( 8 , 181 ) 

181  FORMAT ( 12X, 'MJ' ,6X, 'DIRECTION' ,/,21X, 'F«1 ,B=2'/) 

DO  183  J = 2, JMAX. 2 

182  FORMAT (1X,I2,2X,I8,8X,F5.2) 

183  WRITE ( 8 , 182 ) J , MJ( J) , DIRECT ( J) 

WRITE (8 , 95 ) 

DO  187  I = 1 , IMAX 
LI  I - LI ( I ) 

DO  186  L = 1.LII 

WRITE(8, 185)  L.I.GIL(L.I) ,L,I , EPSIIL(L.I) 

185  FORMAT( IX. 'GIL( ' , 12, ' , ' ,12, ' ) = '.E11.4.4X, 

* 'EPSIIL(  ' , 12, ' , ' ,12, ' ) = '.Ell. 4) 

186  CONTINUE 

187  CONTINUE 
WRITE ( 8 , 95 ) 

DO  200  I * 1 , IMAX 
DO  196  J = 1 , JMAX 
WRITE ( 8 , 195 ) I , J, AI J( I , J) 

195  FORMAT( IX, 'AIJ( ' , 12, ' , ' , 12, ' ) = '.E11.4) 

196  CONTINUE 

200  CONTINUE 
WRITE (8,95) 

DO  205  I = 1.IMAX+1 
DO  202  J = 1 , JMAX 

WRITE (8, 201 ) I , J.NUIJ(I, J) , I , J , NUPI J( I , J ) 

201  FORMAT( IX, 'NUIJ( ' ,12, ' , ' , 12, ' ) = ' , 15 , 9X , 'NUPI J(  ' , 12, ' . ' , 

* 12,  ' ) - ' , 15) 

202  CONTINUE 
205  CONTINUE 

WRITE ( 8 , 95  ) 

DO  225  1=1, IMAX 
DO  220  J = 1 , IMAX 

WRITE (8, 2 10)  I, J,SIGIK(I, J),I, J,ALPIK(I, J),I, J , BETAIK( I , J) 

210  FORMAT ( 1X,'SIGIK(',I2,',',I2,')  = '.E10.4.1X, 

*'ALPIK(  ' ,12, ' , ' ,12, ')  = ' , E10.4, IX, 'BETAIK( ' , 12, ' , ' ,12,  ' ) = '. 

*E 10 . 4 ) 

220  CONTINUE 
225  CONTINUE 

WRITE ( 8,95) 

WRITE ( 8 , 230) 

230  FORMAT (7X,25('*'),'  END  INPUT  ', 25 ('*')/// ) 

WRITE (8, 231) 


I 


I 


s* 


c - 4 


231  FORMAT ( 25X, '***  SHOCK  GEOMETRY  +++'//) 

NXPSTM  - NXPST  - 1 

C DEFINE  SHOCK  GEOMETRY 

CALL  SHOCKG  (NXPSTM, ITK) 

C IZTERM  * NO.  OF  DELTA  X INCREMENTS  GENERATED  IN  SHOCKG 

WRITE (8,95) 

IF  ((NXPST  - 1.0). LE. IZTERM)  GO  TO  237 
WRITE ( 15,235) 

235  FORMAT( IX, ' (NXPST- 1 ). GT . IZTERM  : IT  MUST  BE  .LE.  TO  IZTERM',/, 

* IX. 'PHYSICAL  SPACE  CALCULATIONS  - SEE  DO  700  LOOP  : STOP  301'/) 

STOP 

237  WRITE (8,95) 

IF  ( IZTERM . LE . 500)  GO  TO  241 
WRITE( 15,240) 

240  FORMAT( IX. 'IZTERM. GT.500:CHGE  DIM  OF  P.DPDX  AND  VARI : STOP  301'/) 

STOP 

C FREESTREAM  QUANITIES 

241  SUM  « 0.0 

DO  245  I « 1 , I MAX 
245  SUM  * SUM  + Cl INF ( I )/MUI  ( I ) 

MUINF  « 1.0/SUM 

RHOINF  * MUINF*PINF/(R*TINF) 

AINF  - DSQRT(GAMMA*R*TINF/MUINF ) 

MINF  « VINF/AINF 

C FOR  EACH  I , SPECIE 

EINF  « 0.0 
DO  275  I - 1 , I MAX 
TEM  - DEXP(THETAI ( I )/TINF ) 

EVIINF(I)  « ( R* THETA I (I))/(MUI(I)*(TEM  - 1.C))*FI(I) 

C FOR  EACH  L,  REACTION  LEVEL 

GSUM  « 0.0 
GESUM  « 0.0 
LI I « LI ( I ) 

IF  (LII.LE.20)  GO  TO  255 
WRITE( 15,250)  LII 

250  FORMAT( IX, 'LII  *'.I3,2X.'A  LEVEL  IN  LI  ARRAY  IS  GREATER  THAN  20'. 

* 2X , / , IX , ' YOU  NEED  TO  CHANGE  DIMENSION  OF  EPSIIL  AND  GIL') 

255  CONTINUE 

DO  265  L * 1 , LI I 

TEM1  - DEXP(-EPSIIL(L.I)/TINF) 

GSUM  * GSUM  + GIL(L, I )*TEM1 
GESUM  * GESUM  + GIL( L . I ) *EPSI I L( L , I ) *TEM1 
265  CONTINUE 

EEIINF  * R/MUI ( I )*(GESUM/GSUM) 

El INF  * 1 .5*R*TINF/MUI(I)  + FI ( I ) *R*TINF/MUI ( I ) + EVIINF(I) 

* + EEIINF  + DELHI ( I )/MUI ( I ) 

EINF  * EINF  + El INF *CI INF ( I ) 

275  CONTINUE 

WRITE (8, 280)  MUINF . RHOINF , AINF , TINF , PINF , VINF , MINF , El INF , EINF . 

* EEIINF 

280  FORMAT ( 24X, '+++  FREESTREAM  QUANTITIES  +++',///. 6X , 'MUINF  * '.Eli. 4 
*,3X, 'RHOINF  « ' ,E11 . 4 , 3X , 'AINF  * ' , E 1 1 . 4 ,//,6X, 'TINF  - '.E11.4.3X 
* , 'PINF  «=  '.E11.4.3X, 'VINF  * ' , E 1 1 . 4 , // , IX , 'MINF  - '.E10.4.2X. 

* ' El INF  * ' .E10.4.2X, 'EINF  * ' , E 10. 4 . 2X , ' EEIINF  * '.E10.4//) 

DO  285  I * 1 , I MAX 

285  WRITE (8 , 286 ) I.EVIINF(I) 

286  FORMAT( IX, 'EVIINF( ' .12, ' ) * '.Ell. 4) 

WRITE ( 8 , 95 ) 

C BEGIN  QUANTITIES  BEHIND  SHOCK  FOR  THE  RANGE  OF  X 

WRITE ( 8 , 290) 

290  FORMAT ( 22X , ' +++  QUANTITIES  BEHIND  SHOCK  +++',///. 5X , 'TS ', 9X ,' ES' , 

*9X, 'PS' ,7X, 'RHOS' ,8X, 'US' ,8X, 'PSIS' ,8X, 'HS'/) 

IF  (NXPST.GE.3)  GO  TO  293 
WRITE( 15,291) 

STOP 

291  FORMAT( IX, 'NXPST  * 2 - SURELY  SOME  PHYSICAL  SPACE  VALUES' ./, IX , 

* 'ARE  DESIRED  --  MAKE  IT  AT  LEAST  3 : STOP  2') 

C 

293  DO  385  IX  « 1 .IZTERM 
TEM  * SINTM( IX ) **2 
LAMBDA  - RHOINF* VINF*SINTM( IX ) 

OMEGA  «=  PINF  + RH0INF*VINF**2*TEM 

DELTA  = EINF  + PINF/RHOINF  + ( VINF**2*TEM)/2 . 0 

LAMSQ  * LAMBDA**2 

OMEGSQ  * 0MEGA**2 

MINFSQ  « MINF**2 

TEM  = TEM*MINFSQ 

TSG  « ( TINF* ( 2 . 0* GAMMA *TEM  - (GAMMA  - 1 . 0) )*(( GAMMA  - 1.0) 

* *TEM  + 2.0) )/( (GAMMA  + 1.0)**2*TEM) 

TOL 1 * .001 


T0L2  « .0001 
MAXI  - 50 
C 

IF  (IQ3.EQ.1)  CALL  F0FTS1  (MAXI , TOL 1 , T0L2 . ICODE , TSG) 

IF  (I03.GT.1)  CALL  F0FT23  (MAXI , TOL 1 .T0L2 . ICODE , TSG, 101 . 102 , 103) 

C 

IF  (ICODE. E0.1)  WRITE ( 1 5 , 330)  TSG 
330  FORMAT ( IX , ' ****  MAXIMUM  ITERATION  EXCEEDED  IN  FOFTS  ****'.//. 

* IX , ' LAST  ITERATED  VALUE  OF  TSG  WAS  '.E15.6,'  : STOP  321'/) 

IF  (ICODE. EO. 2)  WRITE ( 15 , 335) 

335  FORMAT ( IX, '***«*  DERIVATIVE  * 0.0  IN  FOFTS  *****  : STOP  321'/) 
IF  (ICODE. EO. 1 .OR. ICODE. EO. 2)  STOP 

c STOP  321 

IF  (IX.EO. 1)  TSTAG  - TSG 
TS  - TSG 
ES  * 0.0 

DO  360  I « 1.IMAX 

IF  (M.E0.1)  EVIS(I)  * EVIINF(I) 

IF  (M.EQ. 1)  GO  TO  345 
TEM  - DEXP(THETAI ( I )/TS ) 

EVIS(I)  « (R*THETAI ( I ) )/ (MU I ( I )* (TEM  - 1.0))*FI(I) 

345  SUMG  * 0.0 
SUMGE  * 0.0 
LII  * LI ( I ) 

DO  350  L * 1.LII 

TEM1  * DEXP(-EPSIIL(L. I )/TS) 

SUMG  « SUMG  + TEM1 *GI L( L , I ) 

350  SUMGE  * SUMGE  + TEM1*GIL(L. I )*EPSIIL(L. I ) 

EEIS  * (R/MUI ( I ) )*(SUMGE/SUMG) 

EIS  * (1.5*R*TS)/MUI(I)  + ( FI ( I ) *R*TS )/MUI ( I ) + EVIS(I) 

* + EEIS  + DELHI ( I )/MUI ( I ) 

IF  (IQ3.EQ.1)  THEN 

ES  * ES  + EIS*CI INF ( I ) 

ELSE 

ES  - ES  + EIS*CID( IX , I ) 

END  IF 

360  CONTINUE 

PS  * DSQRT(OMEGSQ  - 2 ,0*LAMSO*(DELTA  - ES)) 

RHOS  * (MUINF*PS)/(R*TS) 

US  * VINF*COSTM( IX) 

PSIS  * (RHOINF*VINF*RSM( IX)**2)/2.0 
HS  * PS/RHOS  + ES 

WRITE (10.*)  IX, TS.ES.PS. RHOS, US, PSIS ,HS 
WRITE ( 8 , 365 ) TS.ES.PS, RHOS , US , PSIS . HS 

365  FORMAT (1X,7(E9.4,2X)) 

WRITE (9 , 366)  IX 

366  FORMAT( IX, 'FOR  IZTERM  = ',13//) 

DO  370  I « 1 , I MAX 

WRITE (9 , 367 ) I.EVIS(I) 

367  FORMAT (13X,'EVIS('.I2,')  * '.Eli. 4) 

370  CONTINUE 

WRITE ( 1 1 , * ) (EVIS(I).I  = 1.IMAX) 

WRITE ( 9 , 620) 

385  CONTINUE 
C 

REWIND  9 
REWIND  10 
REWIND  11 

C COMPUTE  PRESSURE  DISTRIBUTION  FOR  EACH  PSI 

DO  390  IPSI  = 1, IZTERM 
DO  388  IX  « 1, IZTERM 
IF  (IX.EO. IPSI)  XX  = X1(IX) 

READ ( 10,*)  IXT.TS.ES, PS. RHOS. US. PSIS, HS 
IF  (IXT.LT.IPSI)  GO  TO  388 
IF  (IXT. EO. IPSI)  PSISHK  = PSIS 
IF  (IPSI. EO. IX)  THEN 
P(IX)  = PS 
GO  TO  388 
ENDIF 

P(IX)  = PS  + US/( RCM( IX)*RSM(IX) ) *( PSI SHK  - PSIS) 

388  CONTINUE 
REWIND  10 

WRITE( 12 , * ) XX,(P(IX),IX  * 1, IZTERM), IPSI. IZTERM 
390  CONTINUE 
REWIND  12 

C COMPUTE  DPDX  AND  VARI 

DO  404  IPSI  = 1, IZTERM 

READ( 12,*)  X , (P( I ) , I* 1 . IZTERM) , IPI , IZTERM 
ITHIS  = O 

DO  401  IX  = IPSI , IZTERM 


oooooooooooooo 


IF  (IX. EQ. IPSI)  XT  ■ x 

IF  (IX.GT.IPSI. AND . IPSI . LT .( NSR+2 ) ) XT  « XT  + DELX/NSR 
IF  (IX. GT. IPSI. AND. IPSI. GT.(NSR+1))  XT  ■ XT  + DELX 
ITHIS  » ITHIS  + 1 
VARI(ITHIS)  « XT 

401  CONTINUE 

DO  403  IX  - IPSI , IZTERM 

C DIFFERENTIATE 

IF  (IX. NE. IPSI)  GO  TO  402 

DPDX(IX)  « (-  3 . *P( IX)  + 4 . *P( IX+1  ) - P(IX+2))/(2.0*DELX) 

GO  TO  403 

402  DPDX(IX)  ■ (-  P(IX-1)  + P(IX+1))/(2.0*DELX) 

IF  (IX. NE. IZTERM)  GO  TO  403 

DPDX(IX)  » (P( IX-2)  - 4 . *P( IX- 1 ) + 3.*P(IX))/(2.0*DELX) 

403  CONTINUE 

WRITE ( 13,*)  (DPDX(I ) , 1=1 , IZTERM) , IPSI. IZTERM 

404  CONTINUE 
REWIND  13 
REWIND  12 


DO  405  IX  • 1, IZTERM 
IF  (IX. EO. 1)  VAR 1(1)  - 0.0 
IF  (IX. EO. 1)  GO  TO  405 

IF  (IX. LT. (NSR+2))  VARI(IX)  ' VARI(IX-I)  + 

IF  (IX.GT. (NSR+1 ))  VARI(IX)  - VARI(IX-I)  + 

405  CONTINUE 

WRITE (8 , 95 ) 

WRITE ( 8 , 407 ) ITK.NXPST 

407  FORMAT( IX, 'XXXXX  ITK  - ' , 13 , 5X , ' NXPST  = ' 

IF  ( ITK .GE. (2*NX PST/4) ) GO  TO  409 
WRITE( 15,408) 

408  FORMAT( IX, 'NO.  OF  X-S  IN  XPST  ARRAY, ITK,  IS  . LT . 

* , IX, 'REEXAMINE  DELX, NXPST  AND  XPST  ARRAY 

STOP 


DELX/NSR 

DELX 


,13.'  XXXXX'//) 


. 5+NXPST ' , / 
STOP  301'/) 

STOP  301 


END  COMPUTATION  OF  QUANTITIES  BEHIND  SHOCK  ; INTEGRATE  ALONG  EACH  PSI 
VAR ( 1 ) « XVAR 

VAR( 2 ) » H, ENTHALPY  VAR(2)  MUST  BE  H,  WHICH  MAY  BE  + OR  - 

CONCENTRATION  OF  SPECIE 

VAR ( 3 ) = Cl ( 1 ) 

VAR ( 2+IMAX ) « Cl ( I MAX ) 

EQUILIBRIUM  VIBRATIONAL  ENERGY 

VAR ( 2+IMAX+ 1 ) = EVI ( 1 ) 

VAR ( 2+IMAX+IMAX ) = EVI(IMAX) 

409  WRITE (8,411) 

411  FORMAT( IX, 'NO.  OF  VIB.  LEVELS  TO  DISSOCIATION',/) 

DO  410  I = 1 , IMAX 

C TRUNCATE 

YIY  = FI(I)*(DELI(I ) /THETA  I ( I ) + 1.0) 

NI  ( I ) » AINT(YIY) 

410  WRITE (8,412)  I,NI(I) 

412  FORMAT( 11X, 'NI( ' ,12, ' ) = ',13) 

WRITE (8,95) 

MU  = 0.0 

N x i + 2* I MAX 

IF  (M.EQ.O)  N = N - IMAX 

C INITIALIZE 

WRITE (8, 415)  IZTERM 
415  FORMAT( IX, 'IZTERM  = ',14///) 

WRITE(8,417) 

417  FORMAT( IX, 'COUPLED  VIBRATION-DISSOCIATION  MODELS ',//, 12X , 

* 'TYPE' , 1 IX, 'NO.  ' ,//,9X, 'VIB.  EQUIL. ' ,8X,  '0' ,/, 12X, 'CVD' , 13X, 

* ' 1 ' ,/, 12X, ' CVDV ' , 12X, '2' ,/,6X, ' CVDV-Pref erent i al ' ,5X, '3' ,/, 

* 12X, 'PARK' , 12X , '4'///) 

WRITE(8,418) 

418  FORMAT (7X, 'SHOCK  JUMP  CONDITION  MODELS ',//, 12X , 

* 'TYPE' , 1 IX, 'NO. ' ,//,6X, 'CHEMISTRY  FROZEN ', 6X ,' 1 ',/, 5X , 

* ' N2  FROZEN,  02  DISS . ' , 4X , ' 2 ' , / , 7X , ' N2  AND  02  DISS . ' , 6X , ' 3 '//) 

IF  ( MW . EQ . 1 . AND . IMAX . EQ . 7 ) THEN 
WRITE (8, 419) 

419  F0RMAT(3X, 'MILLIKAN  AND  WHITE  DATA  FOR  N2  WAS  SELECTED'/) 

END  IF 

IF  (MW. EQ. 1 . AND. IMAX. EQ. 10)  THEN 
WRITE ( 8 ,426 ) 

426  F0RMAT(3X, 'MILLIKAN  AND  WHITE  DATA  FOR  N2  AND  N2+  WAS  SELECTED'/) 
ENDIF 


CIH 


o o 


KSTAG  » 0 
ISTAG  - 0 
XPST(1)  » DELX 

XPST(NXPST)  - VARI ( IZTERM)  100.0 

SUMCI  -0.0 

WRITE(8,95) 

LPS 1 * 1 
IPSI  - 0 

C BEGIN  EACH  STREAMLINE  COMPUTATION  HERE 

420  IPSI  - IPSI  + 1 

IF  (IPSI .EQ. IZTERM)  GO  TO  735 
425  KIPF  - 0 

C ISTAG  « 2 FOR  STREAMLINE  DELX 

IF  (ISTAG. EO. 1)  ISTAG  * 2 
READ( 10,*)  IX, TS.ES.PS, RHOS , US , PSIS , HS 
READOl,*)  (EVIS(I).I  - 1.IMAX) 

IF  (IPSI .EO. 1 ) HSTAG  - HS 
CJ  - XI 
SPEC  « 0.0 

C EVALUATE  DERIVATIVES  WHEN  SPEC  « 0.0 

II  « 0 

C USE  SHOCK  VALUES  FOR  INITIAL  COMPUTATION  ON  EACH  STREAMLINE 

KEYINT  ■ 0 
IX  « 0 
T « TS 

IF  (M.EO.O)  GO  TO  450 
DO  445  I - 1 , I MAX 
445  TVI(I)  ■ TINF 
GO  TO  460 

450  DO  455  I • 1.IMAX 
455  TVI(I)  « TS 
460  RHO  * RHOS 

IF  (I03.GT. 1)  THEN 
SUM  * 0.0 
DO  462  I * 1 , I MAX 

462  SUM  * SUM  + CID( IPSI , I )/MUI ( I ) 

MU  - 1.0/ SUM 
END  IF 

IF  (I03.E0. 1)  MU  * MUINF 
U » US 

DO  465  I = 1 , I MAX 
MM  * 2 + I 
K « IMAX  + MM 
VAR(MM)  - 0.0 

IF  (IQ3.EQ.1)  VAR(MM)  « CIINF(I) 

IF  (I03.GT.1)  VAR(MM)  « CID(IPSI.I) 

VAR(K)  ■ 0.0 

IF  (M.EO.O)  VAR(K)  « EVIS(I) 

IF  (M.EQ.1)  VAR(K)  « EVIINF(I) 

EVI(I)  « VAR(K) 

465  CONTINUE 

C COMPUTE  S EXPONENT  FOR  PARK  MODEL 

IF  (MODEL. EO. 4)  THEN 
SP  * 3 . 5*DEXP ( -5000 . O/TS ) 

END  IF 
E « ES 
H = HS 

IF  ((IPSI. EQ.(NSR+1)). AND. (ISTAG. EQ.O))  GO  TO  635 
READ(  12, *)  X, (P(L),L=1 .IZTERM) . IPSI , IZTERM 
READ( 13 , *)  (DPDX( L)  , L«1 , IZTERM) , IPSI , IZTERM 
VAR(  1 ) = X 

C OMIT  PSI  * 0.0  STREAMLINE  FOR  NOW  - PICK  IT  UP  LATER 

IF  (X.NE.O.O)  GO  TO  490 
IG  * 0 

WRITE (8 , 725 ) 

GO  TO  730 

490  IF  ( IANS . EO. 1 ) THEN 

IF  ((IPSI. EQ.IS1). OR. (IPSI. E0.IS2). OR. (IPSI. EQ.IS3))  GO  TO  492 
IF  ((IPSI. E0.IS4). OR. (IPSI. EQ.IS5). OR. (IPSI. EQ.IS6))  GO  TO  492 
GO  TO  730 
END  IF 

492  IF  (DABS(X  - VARI ( IPSI )). LE . 1 . 0E-06 ) GO  TO  500 
WRITE ( 1 5 , 495 ) IPSI . X . VARI ( IPSI ) 

495  FDRMAT( IX, 'IPSI  - ',I3,2X,'X  « ' . E 10. 5, 2X . ' VARI ( IPSI ) * '.E10.5, 

*//,1X,'X  AND  VARI ( IPSI ) SHOULD  BE  EQUAL  : EXAMINE  GENERATION  OF  X 
* AND  VARI  IN  MAIN  : STOP  663'/) 

STOP 

STOP  663 

INITIALIZE 

500  IF  (IANS.EO. 1 ) THEN 


I 


IF  ((IPSI.EQ.IS1).0R.(IPSI.EQ.IS2).0R.(IPSI.EQ.IS3))  GO  TO  501 
IF  ((IPSI.EQ.IS4).0R.(IPSI.EQ.IS5).0R.(IPSI.EQ.IS6))  GO  TO  501 
GO  TO  730 
ENDIF 

501  ELB  « 0.0 
SPEC  « 0.0 

IF  (VAR(I).GT.XPST(LPSO)  LPS 1 = LPS 1 + 1 
LPS2  - LPS1 
505  IX  = IX  + 1 

C CALITH  - MODIFIED  RUNGE-KUTTA 

CALL  CALITH  (N, CIMAX , PHMAX ) 

C 

IF  (NERR.EO.O)  GO  TO  575 
IF  (NERR.E0.1)  WRITE( 15,565)  CO.N 

565  FORMAT( IX, 'BAD  INPUT  IN  CALITH' ,/, IX CO  » ' . E 10. 5 , 2X, 'N  » ',14 

• ./, IX. 'STOP  665'/) 

IF  (NERR.E0.2)  WRITE( 15 , 570) 

570  FORMAT( IX, 'EXAMINE  ELE 1 AND  ELE2  IN  CALITH  : STOP  665'/) 

IF  ( (NERR . EO . 1 ) . OR . (NERR . EO . 2 ) ) STOP 

C STOP  665 

575  IF  (IX.EQ.1)  THEN 

IF  (103. NE. 1)  THEN 
IF  (102. EO. 1 ) TE  = TINF 
IF  (102. EO. 2)  TE  - TS 
TE  1 « TE 
TE2  « TE 
ELSE 

TE  = TINF 
TE 1 » TE 
TE2  = TE 
ENDIF 
ENDIF 

C ELECTRON  TEMPERATURE  MODEL 

IF  (IX. EO. 1 ) GO  TO  576 
CORR  = 4 . 23E-06* (T**( -2 . 88 ) ) 

CN  « RH0»6.O2252E+23 
CNN  = CN*VAR( 5 )/MUI ( 3 ) 

CNO  = CN*VAR ( 6 )/MUI (4 ) 

TE  * DLOG( 1 . + lO. 1/((CN0+CNN)*C0RR)) 

TE  - T/( 1 . + TE*T/85000. ) 

TE 1 = TE 

CN2  * RH0*6.O2252E+23»VAR(3)/MUI(1) 

A « DLOG( 1 .010+01 ) - DL0G(CN2)  - DL0G(6 . 4D+00) 

• - 59.»DL0G( 1 .0D+01 ) + 19 . *DLOG( TVI ( 1 )) 

A « DEXP(A) 

TE  = DLOG( 1 . + A) 

TE  = TVI ( 1 )/( 1 . + TE*TVI ( 1 )/85000 . ) 

TE2  - TE 
C 

576  IF  (IX.EQ.1)  GO  TO  580 

IF  ((IPSI .EO. (NSR+1 ) ) . AND . ( IX . EO . ( NSR+ 1 ) ) ) GO  TO  580 
IF  ( VAR( 1 ) . GE . VAR I ( IZTERM) ) GO  TO  580 

IF  ( (IPSI .LT. (NSR+1 )) .AND. (VAR( 1 ) .GE .DELX) ) GO  TO  580 
KIPF  = KIPF  + 1 
IF  (KIPF.NE.IPF)  GO  TO  625 
KIPF  = O 
580  SUMCI  = 0.0 

DO  590  I SUM  = 3 , IMAXP2 

IF  (VAR(ISUM) .LT.O.O)  NEG  = -1 

IF  (VAR(ISUM). LT.O.O)  WRITE( 15 , 585 ) 

585  FORMAT  (5X  , ' NEGATIVE  Cl  '/) 

590  SUMCI  = SUMCI  + VAR(ISUM) 

DO  595  I CM  = 1 , I MAX 
595  CM(ICM)  = VAR( ICM+2)*MU/MUI ( ICM) 

C PRINT  ANSWERS 

WRITE (8. 600)  IPSI, IX, I 03, MODEL , XVAR,H,MU,PFTL,RHO,U,T,E,SPEC, SUMCI 

600  FORMAT( IX, 'PSI  = ',I4.3X,'IX  = ', 14 , 8X ,' SHOCK  0 COND . = '.I2.14X, 

* ' CVD  MODEL  = ' ,12,//, IX, 'X  = ',D9.4,2X,'H  = ' , D9 . 4 , 2X , ' MU  = ', 

*E9 . 4 , 2X , ' P = ' .E9.4.3X, ' RHO  = ' , E9 . 4 , //. IX , ' U = ',E9.4,2X,'T  = 

*E9 . 4 , 2X , ' E = ' .E9.4.2X, 'CIT  = ' , E9 . 4 , 2X , ' SUMCI  = '.E9.4/) 

IF  (107. EO. IPSI)  THEN 
WRITE ( 15,601 ) XVAR , T , CM( 2 ) , CM( 4 ) , SPEC 

60 1 FORMAT ( 1 X . E9 . 4 , 2X . E9 . 4 . 2X , ES . 4 , 2X , E9 . 4 , 2X  , E9 . 4 ) 

ENDIF 

DO  603  I = 3.IMAXP2 
0=1-2 

603  WRITE (8 , 605 ) J , VAR( I ) , 0 , CM( J ) , U , VAR ( IMAX+I ) 

605  FORMAT (6X , ' Cl ( ' , 12 , ' ) = ' , D 1 1 . 4 , 4X , 'CM( ' , 12 , ' ) = '.E11.4.4X, 

• 'EVI( ' , 12,  ' ) = ' ,D1 1 .4) 

WRITE(8 ,620) 


B ^ 


OO  ooo  nan 


620  FORMAT ( /) 

DO  621  I « 1 , I MAX 
IF  (EVI(I).EQ.O.O)  TVI(I)  * 0.0 
IF  (I.EQ.IMAX)  THEN 
WRITE (8 , 623 ) I , TVI ( I ) , TE 1 , TE2 
GO  TO  621 
END  IF 

WRITE (8 , 622 ) I,TVI(I) 

621  CONTINUE 

622  FORMAT ( 5X , 'TVI ( ' ,12, ')  * ' , E 1 1 . 4 ) 

623  FORMAT (5X , 'TVI ( ' , 12 , ' ) * ' , E 1 1 . 4 , 4X , ' TE 1 - '.E11.4.4X. 

* 'TE2  « '.Ell. 4) 

WRITE (8 , 620) 

IF  (NEG.EQ.-1)  WRITE( 15.630) 

C STORE  INFO  FOR  DISSPLA 

625  IF  (IPSI.EQ.IS7)  THEN 

DO  626  ICM  ■ 1 , IMAX 

626  CM(ICM)  * VAR( ICM+2)*MU/MUI (ICM) 

WRITE ( 70, * ) (CM(I), 1-1, IMAX) 

WRITE(71,*)  T , TVI ( 1 ) , XVAR 

ENDIF 


630  FORMAT ( IX , ' A NEGATIVE  CONCENTRATION  , Cl  IN  MAIN  : STOP  670'/) 

IF  (NEG.EQ.-1)  STOP 

STOP  670 

WHEN  IPSI  » (NSR+1),  DELX  AND  STAGNATION  STREAMLINES  WILL  BE  COMPUTED 

IUNEG  ■ 1 IF  U**2  NEG.  IN  BASIC 

IF  ( IUNEG. EO. 1)  GO  TO  735 

IF  ((IPSI. LT. (NSR+1)). AND. ( VAR ( 1 ) . LT . XPST( 1 ) ) ) GO  TO  505 
IF  ( (ISTAG.EO. 1 ) .OR.  (ISTAG.E0.2) ) GO  TO  690 

ISTAG  = 0 UNTIL  AFTER  EXTRAPOLATION  FOR  PSI  - 0.0  STREAMLINE 

ISTAG  = 1 FOR  PSI  » 0.0  STREAMLINE 

ISTAG  * 2 FOR  DELX  STREAMLINE  AND  THEREAFTER 


C 


635  IG  - IG+1 
IGC  « 0 

IGE  * IMAX  + 2 
PSIG(IG)  « PSIS 
DO  640  IG1  = 3, IMAXP2 
IGC  « IGC  + 1 
CIG(IGC.IG)  = VAR(IGI) 

IGE  * IGE  + 1 
EIG(IGC.IG)  ■ VAR(IGE) 

640  CONTINUE 
EG(IG)  - E 
TG(IG)  = T 
HG(IG)  = H 

IF  (IPSI .LT. (NSR+1 ) ) WRITE ( 8 , 725 ) 

IF  (IPSI. LT. (NSR+1))  GO  TO  730 

IPSI  = (NSR+1)  IS  THE  STAGNATION  STREAMLINE 
AT  DELX  .EXTRAPOLATE  FOR  PSI  - 0.0  VALUES 

PSI  = 0.0 


MG  * 1 

CALL  FTLUP  ( PS I , E , MG , I G , PSI G , EG ) 

CALL  FTLUP  ( PSI . T , MG, IG, PSIG . TG) 

CALL  FTLUP  ( PSI , H , MG , IG , PSIG , HG) 

1 , IMAX 
* 1.NSR1 
CIG( IG2 , IG1 ) 

EIG( IG2 , IG 1 ) 

CALL  FTLUP  ( PSI , Cl ( IG2 ) , MG , IG , PSIG , CIT ) 
IF  (CI(IG2).LT.0.0)  Cl ( IG2 ) * 1.0E-08 
CALL  FTLUP  ( PSI . EVI ( IG2 ) , MG , IG , PSIG , EIT ) 
650  VAR(2+IMAX+IG2)  = EVI(IG2) 


DO  650  IG2 
DO  645  IG1 
CIT(IGI)  = 
645  EIT(IGI) 


INITIALIZE  FOR  PSI  = 0.0  STREAMLINE 

CU  = XI 

SPEC  = 0.0 

II  = 0 

KEYINT  = 0 

IX  = 0 

SUM  =0.0 

DO  660  I = 1 , IMAX 

SUM  = SUM  + Cl ( I )/MUI ( I ) 

IF  (EVI(I).EQ.O.O)  TVI ( I ) = 0.0 
IF  (EVI(I).EQ.O.O)  GO  TO  660 

XL  = ((DGENI(I) *R*THETAI ( I ) )/ ( MUI ( I ) *EVI ( I ) ) + 1.0) 

ALN  = DLOG(XL) 

TVI (I)  = THETAI ( I )/ALN 
660  CONTINUE 

MU  = 1 . O/SUM 

U = DSQRT(2.0*(HSTAG  - H)) 
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VAR( 1 ) - DELX 

C COMPUTE  P AND  DPDX  AT  IPSI  « (NSR+1)  (AT  THE  BODY) 

IF  (IANS.EO.O)  WRITE (8 , 665 ) 

IF  ((IPSI .EQ. IS  1 ) .OR. (IPSI .EQ. IS2) .OR. (IPSI .EQ. IS3) ) WRITE (8. 665) 

IF  (( IPSI. EO. IS4). OR. ( IPSI. E0.IS5). OR. ( IPSI. E0.IS6))  WRITE(8,665) 
665  FORMAT ( IX , ' PSI  - 0.000  STREAMLINE  --'/) 

P(NSR+1)  « PS  + US/ ( RCM(NSR+ 1 ) *RSM(NSR+ 1 ) ) * ( —PSI S ) 

RHO  - P(NSR+ 1 )/ ( H - E) 

NSR2  « NSR  + 2 

DO  670  I - NSR2 , IZTERM 

READ( 10,*)  IXT,TS,ES,PS,RHOS,US,PSIS.HS 
670  P(I)  * PS  + US/ ( RCM( I ) *RSM( I ) ) * ( - PSIS) 

REWIND  10 
REWIND  11 

DPDX(NSR+1)  * (-3.*P(NSR1)+4. *P(NSR2 )-P(NSR+3 ))/(2.*DELX) 

C EVALUATE  DPDX  FROM  (NSR+2)  TO  IZTERM 

DO  680  I « NSR2, IZTERM 
IF  (I. LT. IZTERM)  THEN 
DPDX ( I ) « (-  P( I- 1 ) + P(I+1))/(2.*DELX) 

ELSE 

DPDX(I)  * (P( 1-2)  - 4 . *P ( I - 1 ) + 3.*P(I))/(2.*DELX) 

END  IF 

680  CONTINUE 

DO  685  I * 1.NSR 

READ( 10,*)  IX, TS.ES.PS, RHOS , US , PSIS , HS 
685  READ(11,*)  (EVIS(d).J  ■=  1.IMAX) 

ISTAG  « 1 
PSIS  « 0.0 
GO  TO  500 

AT  EACH  X WHERE  PHYSICAL  SPACE  CALCULATIONS  ARE  DESIRED  SAVE 

1 . /( RHO*U ) ON  EACH  STREAMLINE 

690  IF  ( XPST ( LPS2 ) . EO . XPST ( 1 ) ) ICNT  « IPSI 
JJJ  » IPSI  - ICNT  + 1 

IF  (VAR( 1 ) .LT.XPST(LPS2) ) GO  TO  720 
IF  (VAR( 1 ) ,GT.XPST(LPS2) ) GO  TO  705 

C VAR ( 1 ) « XPST ( LPS2) 

RHOURT  « 1 . 0/ ( RHO*U ) 

TEMP(LPS2, JJJ)  « TVI ( 1 ) 

TEMP0(LPS2, JJJ)  = T 
DO  691  III  = 1 , IMAX 

691  RCON( LPS2.III.JJJ)  « VAR(III+2) 

RRH0(LPS2, JJJ)  * RHO 

WRITE ( 14,*)  IPSI .RHOURT, VAR ( 1 ) .PSIS 
GO  TO  715 

705  YPSIS  « PREPSI  + (XPST(LPS2)  - PREX)*((PSIS  - PREPSI)/ 

* ( VAR ( 1 ) - PREX)) 

RHOURT  ■ PRERU  + (XPST(LPS2)  - PREX ) * ( ( RHO*U  - PRERU)/ 

* ( VAR( 1 ) - PREX)) 

TEMP(LPS2, JJJ)  «=  PRETMP  + ( XPST( LPS2 ) -PREX )*( (TVI ( 1 )-PRETMP )/ 

* ( VAR( 1 ) - PREX)) 

TEMP0(LPS2,  JJJ)  «=  PRET  + ( XPST ( LPS2 ) -PRET ) * ( (T-PRET )/ 

* ( VAR ( 1 ) -PRET  ) ) 

DO  706  III  * 1 , IMAX 

706  RCON( LPS2 , I I I , JJJ ) = PREC( I I I )+ (XPST( LPS2 ) -PREX ) * ( ( VAR( I I 1+2 ) 

* -PREC(III ) )/(VAR( 1 )-PREX) ) 

RRH0(LPS2, JJJ)  = PRERHO  + ( XPST( LPS2 ) -PREX ) * ( ( RHO-PRERHO )/ 

* ( VAR ( 1 ) - PREX)) 

RHOURT  = I.O/RHOURT 

WRITE ( 14,*)  IPSI .RHOURT, XPST (LPS2) .YPSIS 
715  LPS2  »=  LPS2  + 1 
KSTAG  = KSTAG  + 1 

720  PREX  = VAR ( 1 ) 

PRERU  * RHO*U 
PREPSI  = PSIS 
PRETMP  * TVI ( 1 ) 

PRET  = T 

DO  721  III  = 1 , IMAX 

721  PREC(III)  = VAR ( I I 1+2 ) 

PRERHO  = RHO 

IF  (VAR( 1 ) .LT.VARI(IZTERM) ) GO  TO  505 
C END  OF  STREAMLINE 

WRITE(8,725) 

725  FORMAT ( IX, ' XXXXXXXXXXXXXXXX ' / ) 

IF  (( IPSI . EO. (NSR+1 )) .AND. (ISTAG. EO. 1 ) ) GO  TO  425 
730  GO  TO  420 

C COMPUTE  PHYSICAL  SPACE  VALUES 

735  REWIND  10 
REWIND  11 
REWIND  12 
REWIND  13 


ns 
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WRITE (8 , 740)  KSTAG 

740  F0RMAT( IX, 'BEGIN  PHYSICAL  SPACE  CALCULATIONS  KSTAG  * '.15/) 

C 

LPS3  - 0 
IXSTR7  - O 

DO  840  LPS  • 1.NXPST 
REWIND  14 
IK  = O 

745  LPS3  * LPS3  + 1 

IF  (LPS3.GT. IZTERM)  GO  TO  840 

IF  (DABS(X1 (LPS3)  - XPST ( LPS ) ) . GT . 1 . 0E-08 ) GO  TO  745 

DO  780  IPS  * 1. KSTAG 

READ(  14 . * ) IPSI . RHOURT , VAR( 1 ) . PSIS 

VARMX  • VAR( 1 ) - XPST ( LPS  ) 

IF  ( DABS ( VARMX ) . GT . 1 .OE-08 ) GO  TO  780 
IK  « IK  + 1 
I BOB  = IK  - 1 

IF  (IK.GT.200)  WRITE( 15,770)  IK 

770  FORMAT( IX, ' IK.GT.200. CHANGE  DIMENSION  OF  RUT  AND  PSISTG.IK  = ',13) 

RUT (IK)  = RHOURT  . 

PSISTG(IK)  « PSIS 
780  CONTINUE 

C FIND  SMALLEST  DELTA  PSI 

SMALL  « 200.0 
DO  785  I = 2, IK 

IF  ( ( PSISTGC I ) - PSISTG(I-1)).LT. SMALL)  SMALL  * PSISTG(I) 

* - PSISTGC I - 1 ) 

785  CONTINUE 

XDEL  * PSISTGC IK) /SMALL 

C TRUNCATE 

L *=  INTCXDEL  + 1.0) 

C REMAINDERING  M = 0 FOR  EVEN,  M * 1 FOR  ODD 

M = M0DCL.2) 

C MAKE  L EVEN 

IF  (M.NE.O)  L = L + 1 

FIND  INTEGRAL  1./(RH0*U)  DELTA  PSI  FROM  BODY  TO  SHOCK 
USING  SIMPSONS  RULE  ; L INCREMENTS  . L+1  POINTS 

FL  = L 

DPSIS  - PSISTGC IK)/FL 
PSII  * 0.0 

RB  * RUT ( 1 ) + RUT ( IK ) 

DO  800  I = 2,L,2. 

PSII  = PSII  + DPSIS 

CALL  FTLUP  (PSI I , RU1 , 1 . IK, PSI STG , RUT ) 

IF  (I.EO.L)  RB  * RB  + 4.0*RU1 
IF  (I.EO.L)  GO  TO  800 
PSII  - PSII  + DPSIS 

CALL  FTLUP  ( PSI I . RU2 , 1 , IK , PSISTG , RUT ) 

RB  = RB  + 4.0*RU1  + 2.0«RU2 
800  CONTINUE 

RB  = RB*DPSIS/3 .0 

ARR  «=  DSORT ( RSM(  LPS3  ) **2  - 2 . 0*COSTM( LPS3 ) *RB ) 

YI  = (RSMCLPS3)  - ARR )/COSTM( LPS3 ) 

YBDY( IBOB)=YI 

ZE  = ZSM(LPS3)  + YI *SINTM( LPS3 ) 

WRITE (8, 8 15)  PSISTGC 1 ) , X 1 ( LPS3 ) , ARR , YI , ZE 
815  FORMATC  IX. 'PSI  = ' . E 12 . 5 . / , 1 X , ' X = ' , E 13 . 6 , 3X , ' R = '.E13.6 

* , 3X , ' Y = ' .E13.G.3X, 'Z  = '.E13.6/) 

C STORE  BODY  PTS . FOR  DISSPLA 

WRITE(72,»)  ZE , ARR 
C 

DO  830  I = 2. IK 

DPSI  = PSISTGC I ) - PSISTGC I - 1 ) 

C TRAPEZOIDAL  RULE 

TR  = (DPSI/2.0)*( RUT ( I ) + RUT(I-I)) 

RB  = RB  - TR 

ARR  = DSORT ( RSM( LPS3 ) **2  - 2 . 0*COSTM( LPS3 ) *RB  ) 

YI  = (RSMCLPS3)  - ARR )/COSTM( LPS3 ) 

Y(IBOB.I-I)  = YI 

ZE  = ZSMCLPS3)  + YI *SINTM( LPS3 ) 

WRITE (8, 8 15)  PSISTGC I ) ,X1(LPS3) . ARR, YI.ZE 
C STORE  STRLNE  AND  SHOCK  COORD.  FOR  DISSPLA 

IF  (I.EQ.IK)  THEN 
IF  ( ( I+NSRM1 ) . EQ. IS7)  THEN 
IXSTR7  = IXSTR7  + 1 

WRITE (73,*)  ZSM( I S7 ) , RSM( IS7),X1(IS7) 

XSTR1 ( IXSTR7 ) = X1(IS7) 

ZSTR1 ( IXSTR7  ) = ZSM(IS7) 

RSTR 1 ( IXSTR7  ) = RSM(IS7) 

ENDIF 
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WRITE ( 74 , * ) ZE.ARR 
GO  TO  830 
END  IF 

IF  ( ( I +NSRM 1 ) . EQ . I S7 ) THEN 
IXSTR7  - IXSTR7  + 1 
WRITE ( 73 , * ) ZE.ARR, X1(LPS3) 
XSTR 1 ( IXSTR7  ) - X1(LPS3) 
ZSTR1 (IXSTR7)  ■ ZE 
RSTR 1 ( IXSTR7 ) - ARR 
END  IF 


830  CONTINUE 

WRITE (8 , 835 ) 

835  FORMAT ( // ) 

840  CONTINUE 

C INTERPOLATE  X COORD.  TO  DETERMINE  (Z.R)  AND  XS 

STRL1  ' 0.0 
PRER11  « 0.0 
PREZ11  » 0.0 
PRESTL  - 0.0 
REWIND  71 

841  READ(71,*, END-842)  T 1 1 , TVN2 1 , XS 1 

CALL  FTLUP  ( XS 1 , R 1 1 , 2 , IXSTR7 , XSTR  1 , RSTR 1 ) 

CALL  FTLUP  ( XS 1 , Z 1 1 . 2 , IXSTR7 , XSTR 1 , ZSTR 1 ) 

SEG  « DSQRT ( ( PRER 1 1 - R11)**2  + (PREZ11  - Z11)**2) 

IF  (XS 1 . EO . X 1 ( IS7) ) SEG  - 0.0 

STRL1  ■ PRESTL  + SEG 

WRITE ( 75 , * ) XS1.Z11 ,R11 .STRL1 

PRESTL  - STRL1 

PRER  1 1 - R 1 1 

PREZ11  ' Z11 

GO  TO  841 

c RADIATION  MODELS 

842  IF  (I04.EQ.0)  GO  TO  845 

IF  (I05.EQ.0)  WRITE ( 8,9191) 

9191  FORMAT ( /// , ' NDNEQUILIBRIUM  RADIATION  MODELS'.///) 

IF  (I04.E0.1)  CALL  OLRAD  (104,105.106,108.109,1010) 

IF  (104. EO. 2)  CALL  CARRAD  ( 104 . 105 . 109 ) 

IF  (IQ4.E0.3)  CALL  CORRAD  (104,105,106.108,109) 

IF  (IQ4.EQ.4)  CALL  ANDRAD  (104,105,109) 

IF  ((104. EO. 5) .OR. (104. EO. 6))  THEN 
CALL  OLRAD  (104,105,106,108,109.1010) 

CALL  CARRAD  (104,105,109) 

CALL  CORRAD  (104,105,106,108,109) 

CALL  ANDRAD  (104,105,109) 

ENDIF 

IF  (IQ5.EQ.0)  THEN 
DO  1920  K = 3.NXC0N 
WRITE(8, 1911)  XPST(K) 

DO  1920  d « I.NPTS(K) 

WRITE (8, 1921 ) d.ALPN(K.d) .ALPO(K.d) .BETN(K.d) ,BETO(K,d) 

1921  FORMAT ( ' J « ',12,'  An  « '.D11.4,'  Ao  « '.D11.4/ 

* ' ' , 2X , ' BN  * ' ,D1 1 .4, ' BO  * Dll. 4) 

1920  CONTINUE 
ENDIF 

DO  1912  K ■ 3.NXC0N 
WRITE(8, 1911)  XPST(K) 

1911  FORMAT(/// , ' AT  X * '.Dll. 4,///) 

DO  1912  d = 1 , NPTS( K ) 

WRITE(8, 1913)  d,TEMP(K,d).RRHO(K,d),TEMPO(K,d) 

1913  FORMAT ( ' d*',I2,'  TE«',F10.2,'  RHO« ' , D 1 1 . 4 . ' T«',F10.2) 

1912  CONTINUE 

DO  1918  K « 3, NXCON 
WRITE(8, 1911)  XPST(K) 

DO  1918  d = 1 , NPTS(K ) 

WRITE ( 8 , 1914)  d 

1914  FORMAT ( / , ' AT  d = ',12.'  NUMBER  DENSITIES  ARE  ',/) 

DO  1918  I « 1.IMAX 

WRITE(8, 1915)  I , RCON(K , I , d ) 

1915  FORMAT ( ' SPECIES  * ',12,'  N * '.D11.4) 

1918  CONTINUE 

WRITE ( 8 , 835 ) 

845  WRITE ( 8 , 850) 

850  FORMAT( IX, 'END  THIS  CASE  , HALLELUdAH  '/) 

REWIND  8 
REWIND  14 
STOP 
END 
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c 

SUBROUTINE  BASIC 


BASIC  CALLED  BY  CALITH  TO  EVALUATE  DERIVATIVES  H DOT, 

C SUB  I DOT  AND  EV  SUB  I DOT  ; DERIVATIVES  START  IN  DER( 1 ) 


\ 

) 


C 

C 

C 

C 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 


c 


c 
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IMPLICIT  REAL*8 ( A-H , O-Z ) 

COMMON  /A  1/  TE1 ,TE2,M, IX, IMAX, IPSI .MODEL 
COMMON  / A2/  P( 500) , DPDX ( 500) , VARI ( 500) 

COMMON  /A3/  EVIINF(25),THETAI(25).MUI(25),FI(25),DELHI(25). 
1 Cl INF ( 25 ) , LI ( 25 ) 

COMMON  / A4/  R.MUINF, DELTA, LAMSO , OMEGSO, OMEGA. MU, T.U.TINF 
COMMON  /A5/  EPSIIL(20,25),GIL(20,25) , CID( 200, 50) 

COMMON  / A6/  VAR( 52 ) , CUVAR( 52 ) ,DER(51 ) 

COMMON  /A7/  MJ(50),EJ(50),AJ(50),BJ(50),DIRECT(50) 

COMMON  /A8/  TVI (25)  .DGENI (25) ,BI (25) ,NI(25) 

COMMON  /A  10/  NUIU(26, 50) . AI J(25, 50) ,NUPIvJ(25, 50) 

COMMON  /All/  SIGIK(25,25) , ALPIK( 25 , 25 ) , BETAIK( 25 , 25 ) 

COMMON  /A  1 3/  SP.TS.DE LX, 2STERM, IZTERM.NSR, MW 

COMMON  /A  1 4/  EINF.PINF, RHOINF , VINF , E , UMAX , KEY I NT , RHO , HSTAG 

COMMON  /A  1 5/  PFTL.KITR1 ,NIP(25) ,UP(25) 

COMMON  /A  16/  WE(25) ,WEXE(25) ,WEYE(25) ,WE2E(25) , IUNEG 
COMMON  /A  1 8/  ITNEG.IEXP 

DIMENSION  PHI (50) , Sd ( 50 ) , DCI JDX ( 50 ) , EVP( 100) 

DIMENSION  Cl (25) , EVI (25) ,DCIDX(25) ,DEVIDX(25) , EVIBAR(25) 
EQUIVALENCE  (CUVAR(2) ,H) , (CUVAR(3) , Cl ( 1 ) ) 

EQUIVALENCE  (DER( 1 ) , DHDX ) , ( DER ( 2 ) , DCIDX( 1 ) ) 

REAL*8  KPd , KEQ , Kd ( 50) . LAMSQ.MU.MUI , MUIOT , MUINF , ND 


DER ( 1 ) = DHDX  MUST  BE  DHDX  AS  H MAY  BE  + OR  - 

DER ( 2 ) « DCIDX ( 1 ) 


DER ( 1+IMAX ) 

DER( 1+IMAX+1 ) 
DER( 1 +IMAX+ I MAX ) 


= DCIDX(IMAX) 

= DEVIDX ( 1 ) 

= DEVIDX(IMAX) 


CUVAR( 1 ) * X 

CUVAR ( 2 ) = H, ENTHALPY  - IT  MUST  BE  H WHICH  MAY  BE  + OR  - 
CUVAR  ( 3 )'  = CKO- 

CUVAR ( 2+ I MAX ) = CI(IMAX) 

CUVAR ( 2+IMAX+ 1 ) = EVI(1) 

CUVAR(2+IMAX+IMAX)  = EVI(IMAX) 


KEYINT  = 1 AT  END  OF  1ST  INTERVAL 
IF  (ITNEG.EQ. 1 .OR.IEXP.EQ. 1)  RETURN 
IF  (M.NE.O)  GO  TO  10 
DO  5 I * 1 , IMAX 
dl  = I + IMAX  + 2 
5 CUVAR ( d 1 ) = VAR(dl) 

INTERPOLATE  FOR  P ACROSS  INTEGRATION  INTERVAL 

10  DO  15  I = 1 , IMAX 

15  EVI ( I ) - CUVAR(2+IMAX+I ) 

MFTL  = 1 

NFTL  = IZTERM  - IPSI  + 1 

CALL  FTLUP  ( CUVAR ( 1 ), PFTL , MFTL , NFTL , VARI ( I PSI ), P ( I PSI ) ) 

INTERPOLATE  FOR  DPDX 

CALL  FTLUP  ( CUVAR ( 1 ), DPFTL . MFTL , NFTL , VARI ( IPSI ), DPDX ( I PSI  ) ) 

IF  (KEYINT. EQ.O)  GO  TO  95 

SUM  = 0.0 

DO  45  I = 1 , IMAX 

USE  SHOCK  VALUES  FOR  INITIAL  COMPUTATION  ON  EACH  STREAMLINE 
SUM  = SUM  + Cl ( I )/MUI ( I ) 

IF  (EVI(I).EQ.O.O)  TVI ( I ) = 0.0 
IF  (EVI(I).EQ.O.O)  GO  TO  45 

XL  = ((DGENI(I)*R*THETAI(I))/(MUI(I)*EVI(I))  + 1.0) 

ALN  = DLOG(XL) 

COMPUTE  TVI 

TVI ( I ) = THETAI(I)/ALN 
45  CONTINUE 

MU  = 1 . O/SUM 

U2  = 2 . 0* ( HSTAG  - H) 

IF  (U2.LT.0.0)  WRITE( 15,50)  H 
50  FORMAT ( IX, ' U**2  IS  NEG  IN  BASIC  , H = ' , E 1 1 . 4 , 2X , 

* 'END  STREAMLINE  INTEGRATION') 

IF  (U2.LT.0.0)  IUNEG  = 1 
IF  (U2.LT.0.0)  RETURN 
U = DSQRT ( U2 ) 

ITERATE  FOR  E 

KCODE  = 0 


I 


55 


KITR1 
ICODE 
MAXI  ■ 
TOL 1 ■ 
T0L2  - 


■ 0 
- 0 
50 
.001 
.00001 


1,  TRY  A NEW  STARTING  E.  DO  THIS  2 TIMES 


CALL  FOFE  ( MAXI . TOL 1 . T0L2 . ICODE , E ) 

IF  (ICODE. EQ.O)  GO  TO  75 
IF  (ICODE.  EQ.O  WRITE  ( 15 , 60) 

60  FORMAT( IX , ' * MAXIMUM  ITERATION  EXCEEDED  IN  SUB  BASIC  *:  STOP  66'/) 
IF  (ICODE. EQ. 2)  WRITE(15,65) 

65  FORMAT( IX, ' ***  DERIVATIVE  “ O IN  SUB  BASIC  »***  : STOP  66  /) 

WRITE( 15,70)  ICODE 

70  FORMAT( IX, 'ICODE  « ',12,'  IN  SUB  BASIC  '/) 

IF  (ICODE. NE.1)  STOP 
IF  (KC0DE.E0.3)  STOP 
WHEN  ICODE  - 
KCODE  - KCODE  + 1 
GO  TO  55 

75  IF  ( I EXP .NE.1)  GO  TO  85 
KCODE  « KCODE  + 1 
IEXP  * 0 

IF  (KCODE . EO. 1 ) GO  TO  55 
IF  (KCODE. GT. 2)  RETURN 
E * H - H*1  . E-05 
GO  TO  55 

85  RHO  « PFTL/(H  - E) 

T - (PFTL*MU)/(RHO*R) 

IF  (T.GT.O.O)  GO  TO  95 
WRITE( 15,90)  T , RHO , PFTL , H , E ,MU 

90  FORMAT ( IX , ' T NEGATIVE  = ' , E 12 . 4 , IX , ' RHO  * ' , E 1 1 . 4 , IX , ' PFTL  = ', 

* Ell. 4./.  IX.  'H  - '.Ell  .4.  IX. 'E  » ' , E 1 1 . 4 . 1 X . ' MU  - '.E11.4.2X, 

* 'IN  SUB  BASIC'/) 

E ■ H - H* 1 . 0E-06 
ITNEG  = 1 
RETURN 

95  KEYINT  = 1 

PI  = 4 . 0*ATAN( 1.0). 

BC  = 1 . 38054 E-  16 
AVGN  = 6 . 02252E+23 


STOP  66 


COMPUTE  DCIDX  AND  DEVIDX  FOR  EACH  SPECIE  I 


DO  210  I 
DCIDX(I) 
CVSUM1  » 
CVSUM2  «= 


« 1 . 1 MAX 
« 0.0 
0.0 
0.0 


CORRECTED  RELAXATION  TIME  FOR  PARK  MODEL 
IF  (MODEL. EO. 4 . AND. I . EO. 1 ) THEN 
ND  = RHO*AVGN*CI ( I )/MUI ( I ) 

SIGMAV  « 10.0E-17*( 50000 . /T )**2 
C * DSORT ( 8 . *AVGN*BC*T/ (PI*MUI(I))) 

TAUC  = 1 .0/(C*SIGMAV*ND) 

END  IF 

FOR  EACH  REACTION  0 

DO  190  J * 1 , JMAX 
ICT  = MOD( J , 2 ) 

II  IS  THE  SELECTED  SPECIE  FOR  REACTION  d 

KNT  = O 

IF  (ICT.EO. 1)  THEN 
IF  (DIRECT(d) .EO. 1 .0)  PHIC  = 1.0 
IF  (DIRECT(J) .E0.2.0)  PHIC  * 2.0 
II  * M<J( J) 

100  IF  (M.EQ.O)  GO  TO  115 

IF  ( FI ( I I ) .NE.O.O)  GO  TO  120 

115  IF  (PHIC.EQ.  1 .0)  PHI  ( <J ) ■ 1.0 

IF  (PHIC. EO. 2.0)  PHKU+1)  = 1.0 
GO  TO  125 

120  IF  (MODEL. EO. 3. AND. UP(II) .NE.O.O)  GO  TO  122 
TEM  = DEXP (THETAI (II)/TVI(II)) 

TEM1  = DEXP (THETA I (I  I )/T) 

TEM2  = DEXP(-NI(II ) *(THETAI (II)/TVI(II)  - THETAI ( I I )/T ) ) 

TEM3  = DEXP (THETA I (II)/TVI(II)  - THETAI ( I I )/T ) 

IF  (TEM3.E0. 1 .0. AND. PHIC. EO. 1 .0)  PHI(J)  = 1.0 
IF  (TEM3.EQ. 1 .0. AND. PHIC.EQ. 2.0)  PHI(d+1)  * 1.0 
IF  (TEM3.EQ. 1 .0)  GO  TO  125 

PHI  = COUPLING  COEFF.;  FOR  CVD.CVDV  AND  PARK  MODEL 
IF  (PHIC.EO. 1 .0)  PHI ( J ) = ((1 ,0-TEM2)/(TEM3-1 .0)*(TEM  - 1.0) 

* / (TEM1  - 1.0) )/NI (II) 

(PHIC.EO. 2.0)  PHKJ+1)  = ((1.0-TEM2)/(TEM3-1.0)*(TEM  - 1.0) 

/(TEM1  - 1.0) )/NI (II) 


IF 


GO  TO  125 

122  USUM  ■ 0.0 
TSUM  « 0.0 
TFSUM  « 0.0 
TVTSUM  • 0.0 

TF  ■ 1 .0/(  1 . /TVI  (II)  - 1./T  - I./UPCI)) 

NIC  - NIP(II)  + 1 
DO  123  N - 1 .NIC 
XN  « N 

EEVP  - XN  - 0.5 

EVP(N)  * EEVP*(WE( I 1 ) + EEVP*( -WEXE( 1 1 ) + EEVP* (WEYE( I I ) + 

* WEZE(II)*EEVP))) 

EVP(N)  * EVP (N)  - EVP( 1 ) 

USUM  • USUM  + DEXP( EVP(N)/UP( II)) 

TSUM  « TSUM  + DEXP(-EVP(N)/T) 

TFSUM  * TFSUM  + DEXP(-EVP(N)/TF) 

123  TVTSUM  * TVTSUM  + DEXP ( -EVP(N)/TVI ( I I ) ) 

C COUPLING  COEFF.  FOR  CVDV-PREFERENTI AL  MODEL 

IF  (PHIC. EO. 1 .0)  PHI ( J ) * (TSUM*TFSUM)/(USUM*TVTSUM) 

IF  (PHIC. EO. 2.0)  PHKU+1)  « (TSUM*TFSUM)/(USUM*TVTSUM) 

125  KNT  - KNT  + 1 

IF  (KNT. EO. 1 .AND. PHIC. EO. 1 .0)  THEN 
PHIC  *=  2.0 
II  » Md(d+1) 

GO  TO  100 
END  IF 

IF  (KNT.EO. 1 .AND. PHIC. EO. 2.0)  THEN 
PHIC  - 1.0 
II  « MJ(d+1) 

GO  TO  100 
ENDIF 

C START  OF  LOOP  TO  DETERMINE  EQUILIBRIUM  CONSTANT 

BETAd  « 0.0 
FdORT  * 0.0 
DO  130  K » 1 , IMAX 
SUMG  « 0.0 
LI  I «=  LI  (K) 

DO  128  L = 1.LII 

128  SUMG  - SUMG  + GIL(L.K)*DEXP(-EPSIIL(L,K)/T) 

C MUIOT  * (CHEMICAL  POTENTIAL )/T 

MU10T  = - (BI(K)  + (5.  + 2.*FI(K))/2. * (DLOG(TINF ) + 

* DLOG(T/TINF  ) ) + FI (K ) *DLOG( 1 . /( 1 . - DEXP( -THETAI ( K )/T ) ) ) 

* + DLOG( SUMG/GI L( 1 , K ) ) ) + DELHI (K)/(R*T) 

BETAd  « BETAd  + (NUPId(K.d)  - NUId(K.d)) 

130  FdORT  = FdORT  + (NUPId(K.d)  - NUI d(K , d) )*MUIOT 
C KPd  * EOUIL . CONST.  (IN  TERMS  OF  PARTIAL  PRESSURES) 

KPd  = DEXP ( -FdORT ) 

C KEQ  = EQUILIBRIUM  CONSTANT 

KEO  * KPd* (9 . 8688225 E ”07 *R*T )**( -BETAd) 

C Kd  » RATE  CONSTANT  (FORW:  d « 1,3..  BACK:  d = 2.4,.) 

IF  (DIRECT(d) .EO. 1 .0)  THEN 
Kd ( d ) * Ad(d)*T**Bd(d)*DEXP(-Ed(d)/T) 

IF  ( d . EO .19)  Kd( d ) - Ad ( d ) *TVI ( 1 ) * *Bd ( J ) *DEXP ( -Ed ( d )/TVI ( 1 ) ) 

Kd(d+1)  = Kd(d)/KEO 
ELSE 

Kd(d+1)  = Ad(d)*T**Bd(d)*DEXP(-Ed(d)/T) 

IF  (d . EO . 19 ) Kd(d+1)  * Ad(d)*TVI ( 1 )**Bd(d)*DEXP(-Ed(d)/TVI( 1 ) ) 

Kd ( d ) = Kd( d+ 1 ) *KEO 
ENDIF 
ENDIF 

IF  (NUId( IMAX+1 , d ) . EO . 0)  Sd(d)  = 1.0 
IF  (NUId( IMAX+ 1 , d ) . EO .0)  GO  TO  140 
SUM  =0.0 

DO  135  I SUM  = 1 , IMAX 

135  SUM  = SUM  + Aid ( I SUM , d) *CI ( I SUM) /MU I ( I SUM ) 

Sd(d)  * RHO*SUM 
140  PROD  * 1 .0 

DO  180  IPROD  = 1 , IMAX 
IF  (NUId(IPROD.d) . EO.O)  GO  TO  180 
TEM  ■=  RHO*CI  (IPROD  )/MUI(IPROD) 

IF  (TEM. GE. 0.0)  GO  TO  165 

C LET  PROBLEM  COMPUTE  PROD.  WHEN  Cl  NEG  ; DECIDE  IN  MAIN  ABOUT  ACCEPTING  NEG  Cl 
LABW  = MOD( NUI d( IPROD , d ) , 2) 

C LABW  = 0 FOR  EVEN  NUId.  ABW  = 1 FOR  ODD  NUId 

IF  (LABW.EQ.O)  PROD  = PROD* ( -TEM ) **NUI d ( I PROD , d ) 

IF  (LABW.EQ.O  PROD  = - 1 . 0*PROD* ( -TEM) **NUId( IPROD . d ) 

GO  TO  180 

165  PROD  = PROD*TEM**NUId( IPROD , d) 

180  CONTINUE 

IF  (ICT.EQ.1)  PRODF  = PROD  , 


BETAIU  « NUPIJ(I,J)  - NU 10(1,0) 

DCIUDX(U)  * PHI(d)*KJ(J)*SU(U)*(MUI(I)/(RHO*U))*PROD*BETAId 
C DCIDX  « RATE  OF  PRODUCTION  OF  THE  CONCENTRATION  OF  SPECIE  I 

DCIDX(I)  * DCIDX ( I ) + DCIJDX(J) 

IF  ( ICT.EO.O. AND. MODEL. GT. 1)  THEN 

C QIJ  * NET  RATE  OF  PRODUCTION 

QIJ  * DCIJDX(J-I)  + DCIJDX(J) 

DENOM  « KEQ*PHI( J-1 )*Sd(d-1 )*PRODF 
IF  (DENOM. EO. O.O)  GO  TO  190 

C CHI  ■ DEGREE  OF  NON-EOUI LIBRIUM 

CHI  - 1.0  - (PHI  (d)*Sd( J)*PROD/DENOM) 

DENOM 1 - Cl ( I ) *CHI 
IF  (DEN0M1 .EQ.O.O)  GO  TO  190 
CVSUM1  - CVSUM1  + 01 J/DEN0M1 
CVSUM2  - CVSUM2  + QIJ*(1.0  - CHI )/DEN0M1 
ENDIF 

190  CONTINUE 
C 

TEM  « D EXP (THETA I ( I )/T) 

TEM1  - ( FI ( I ) *DGENI ( I )*R*THETAI ( I ) )/MUI ( I ) 

EVIBAR(I)  » TEM1 / (TEM  - 1.0) 

IF  (M.NE.O)  GO  TO  195 
VAR( I+IMAX+2)  ■ EVIBAR(I) 

DEVIDX ( I ) « 0.0 
GO  TO  210 
195  TAUSUM  « 0.0 

IF  ( FI ( I ) . EQ.O.O)  GO  TO  210 

C CVD  MODEL 

DO  200  K = 1 , IMAX 
TEM3  = DEXP  ( - THETA I ( I )/T  ) 

TEM4  = DEXP(SIGIK(K,I)*T**(-1 ./3. )) 

TEM5  * (FI(I)*ALPIK(K.I))/PFTL 

TAUIK  « TEM5*(T**BETAIK(K. I )*TEM4)/( 1 .0  - TEM3 ) 

C MILLIKAN  & WHITE  RELAXATION  DATA 

IF  (MW.EO. 1)  THEN 

IF  (I.EQ.1)  TAUIK  *=  1 .9E-05*DEXP(216.45*T**(-1 ,/3. ) )/PFTL 
IF  (I.E0.8)  TAUIK  = 3 . 1 845E-05*DEXP ( 198 . 6G*T** ( - 1 . /3 . ) )/PFTL 
ENDIF 

TEM6  * Cl (K) * ( EVIBAR ( I ) - EVI ( I ) ) 

C PARK  MODEL 

IF  ( MODE L . EO . 4 . AND . I . EO . 1 ) THEN 
TAULP  = TAUIK  + TAUC 

PF  * DABS((T  - TVI ( I ) )/( TS  - TINF))**(SP  - 1.) 

TAUSUM  = TAUSUM  + (TEM6/(TAULP*U) )*PF 
GO  TO  200 
ENDIF 

TAUSUM  » TAUSUM  + TEM6/ (TAUIK*U) 

200  CONTINUE 

IF  (MODEL. E0.1)  GO  TO  207 
IF  ( MODEL . EO . 3 ) GO  TO  202 

C ADDITIONAL  TERMS  FOR  CVDV  & PARK  MODEL 

IF  (I.E0.5.0R.I.E0.6.0R.I.E0.8)  GO  TO  207 
TEM7  = DEXP(THETAI(I)/TVI(I)  - THETAI ( I )/T ) 

TEM75  = DEXP(NI(I)/4,*(THETAI(I)/TVI(I)  - THETAI ( I )/T ) ) 

TEM8  = TEM75**4 

CVDVT  * ((THETAI(I)/(TEM7  - 1.)  - NI ( I )* THETA I (I)/(TEM8  - 1.)) 

* *R/MUI ( I ) - EVI ( I ) )*CVSUM1  - ((0.5*(NI(I)  - 1 . ) -THETAI ( I ) 

* *R/MUI ( I ) ) - EVI ( I ) ) *CVSUM2 
TAUSUM  = TAUSUM  + CVDVT 

GO  TD  207 

C ADDITIONAL  TERMS  FOR  CVDV-PREFERENTIAL  MODEL 

202  IF  (I. EO. 5. OR. I. EO. 6. OR. I. EO. 8)  GO  TO  207 
USUM1  = 0.0 
USUM2  * 0.0 
TFSUM1  = 0.0 
TFSUM2  = 0.0 
NIC  = NIP(I)  + 1 

TF  = 1 .0/(1  ,/TVKl)  - 1./T  - 1./UP(I)) 

DO  204  N = 1 ,NIC 
XN  = N 

EEVP  = XN  - 0.5 

EVP(N)  = EEVP* ( WE ( I ) + EEVP* ( -WEXE ( I ) + EEVP* ( WEYE ( I ) + 

* WEZE ( I ) *EEVP ) ) ) 

EVP(N)  = EVP(N)  - EVP ( 1 ) 

USUM1  = USUM1  + DEXP(EVP(N)/UP(I ) ) 

USUM2  = USUM2  + EVP (N ) *DEXP( EVP(N  )/UP ( I ) ) 

TFSUM1  = TFSUM1  + DEXP(-EVP(N)/TF) 

204  TFSUM2  = TFSUM2  + EVP(N)*DEXP( -EVP(N)/TF ) 

GBAR  = (USUM2/USUM1 )*(R/MUI ( I ) ) 

EBAR  = (TFSUM2/TFSUM1 )*(R/MUI ( I ) ) „ , 

5 1.H 
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CVDVPT  « (EBAR  - EVI ( I ) )*CVSUM1  - (GBAR  - EVI ( I ) )*CVSUM2 
TAUSUM  « TAUSUM  + CVDVPT 

C DEVIDX  • EQUILIBRIUM  VIBRATIONAL  ENERGY 

207  DEVIDX(I)  » TAUSUM 

DER( 1+IMAX+I ) - DEVIDX ( I ) 

210  CONTINUE 

C COMPUTE  DHDX 

DHDX  * DPFTL/RHO 
RETURN 
END 


SUBROUTINE  FOFE  ( MAXI , TOL 1 , T0L2 , ICODE . E 1 ) 

CALLED  BY  SUB  BASIC  TO  EVALUATE  E BY  NEWTON  ITERATION  TECHNIQUE 

IMPLICIT  REAL*8(A-H,0-Z) 

COMMON  /A  1/  TE1,TE2,M,IX,IMAX,IPSI, MODEL 
COMMON  / A2/  P(500) ,DPDX(500) , VAR I (500) 

COMMON  / A3/  EVIINF(25) , THETA I (25) , MU 1(25) , F I ( 2 5 ) ,DELHI(25) , 

* CIINF(25) , LI (25) 

COMMON  / A4/  R, MU INF, DELTA, LAMSQ , OMEGSQ , OMEGA , MU , T , U , TINF 
COMMON  / A5/  EPSIIL(20,25) ,GIL( 20, 25 ) , CID( 200, 50) 

COMMON  / A6/  VAR ( 52 ) , CUVAR ( 52 ) , DER ( 5 1 ) 

COMMON  /A7/  MU(50),EJ(50),AJ(50),BJ(50),DIRECT(50) 

COMMON  / A8/  TVI ( 25 ) , DGENI (25) ,BI(25) , NI ( 25 ) 

COMMON  /A  10/  NUI J( 26 ,50),AIJ(25,50), NUPI J( 25 , 50) 

COMMON  /A  15/  PFTL.KITR1 ,NIP(25) ,UP(25) 

COMMON  /A  1 8/  ITNEG, IEXP 
DIMENSION  Cl ( 25 ) 

EQUIVALENCE  ( CUVAR ( 3 ) , Cl ( 1 ) ) , (CUVAR(2)  ,H) 

REAL*8  MUI .LAMSQ, MUINF, MU 

IF  (IEXP. EQ. 1 .OR. ITNEG. EQ. 1 ) RETURN 
KITR1  - KITR1  + 1 
ITER  = 0 
PORHO  = H - El 
T = PORHO*MU/R 
1 ITER  = ITER  + 1 
E - 0.0 
DE  * 0.0 

DO  35  I * 1, IMAX 
IF  ( TVI ( I ) . EQ . 0 . 0)  THEN 
TEM1  = ( 1 ,5*R*T)/MUI(I)  + (FI ( I )*R*T)/MUI ( I ) 

DTEM1  = 1 . 5*R/MUI ( I ) + FI ( I ) *R/MUI ( I ) 

GO  TO  15 
ENDIF 

TEM  = D EXP (THETA I ( I )/TVI ( I ) ) 

TEM1  = (1 ,5*R*T)/MUI(I)  + ( FI ( I ) *R*T )/MUI ( I ) + 

* (FI(I)*R*THETAI(I))/(MUI(I)*(TEM  - 1.0)) 

DTEM1  = 1 . 5*R/MUI ( I ) + FI ( I )*R/MUI ( I ) + ( R*FI ( I ) *THETAI ( I ) **2 ) 

* /(MUI ( I )*TVI ( I )*»2)»(TEM/(TEM  - 1.0)**2) 

15  SUMG  = 0.0 

SUMGE  =0.0 
DSUMGE  = 0.0 
LI  I = LI ( I ) 

DO  25  L = 1 , LII 
TEM3  = - EPSI I L ( L , I )/T 
IF  (TEM3.LT. 741 .67)  GO  TO  22 
IEXP  = 1 
RETURN 

22  TEM2  = DEXP ( TEM3 ) 

SUMG  = SUMG  + GI L ( L , I ) *TEM2 
SUMGE  = SUMGE  + GI L( L , I ) *EPSI I L( L , I ) *TEM2 
IF  (SUMGE . LT . 1 .OD+34)  GO  TO  25 
IEXP  = 1 
RETURN 

25  DSUMGE  = DSUMGE  + TEM2*GI L( L , I ) *EPSI I L( L , I ) **2 

DEVI  = R/MUI(I)*((( SUMG * D SUMGE /T** 2 ) - ( SUMGE/T ) **2 ) 

* /SUMG**2) 

DEI  = DTEM1  + DEVI 

El  = TEM1  + R/MUI(I)*( SUMGE /SUMG)  + DELHI ( I )/MUI ( I ) 

DE  = DE  + DEI *CI ( I ) 

E = E + E I *CI ( I ) 

35  CONTINUE 


c 


IF  (E.GT.H)  ITNEG  = 1 
DFT  = - DE 
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FT  - El  - E 
IF  (DFT.EQ.O.O)  THEN 
ICODE  * 2 
RETURN 
END  IF 

TS1  » T - ( FT/DFT) 

DELT  » DABS(TS1  - T) 

T = TS 1 

El  « H - R*T/MU 
IF  (ITER. GE. MAXI)  THEN 
ICODE  * 1 
RETURN 
ENDIF 

IF  (DELT.GT.TOL1 ) THEN 
ITER1  = ITER 
GO  TO  1 
ENDIF 

ITER2  - ITER1  + 10 

IF  (DELT. LE.T0L2. OR. ITER. GE.ITER2)  RETURN 

GO  TO  1 

END 


SUBROUTINE  F0FTS1  ( MAXI , TOL 1 . T0L2 , ICODE , TSG ) 

CALLED  BY  MAIN  TO  EVALUATE  TS  BY  NEWTON  ITERATION  TECHNIQUE 

IMPLICIT  REAL*8(A-H,0-Z) 

COMMON  /A  1/  TE1.TE2.M, IX, IMAX.IPSI, MODEL 
COMMON  / A2/  P( 500) , DPDX ( 500) , VARI ( 500) 

COMMON  / A3/  EVIINF(25),THETAI(25), MU 1(25), FI(25),DELH 1(25) 

* ,CIINF(25),LI(25) 

COMMON  /A4/  R.MUINF, DELTA, LAMSQ . OMEGSQ , OMEGA, MU, T.U.TINF 
COMMON  /A5/  EPSIIL(20,25) ,GIL(20,25) ,C ID (200, 50) 

COMMON  /AG/  VAR( 52 ) , CUVAR( 52 ),DER(51) 

REAL*8  MUI, LAMSQ, MUINF, MU 

C 

ITER  « 0 

1 ITER  « ITER  + 1 
ES  - 0.0 
DES  * 0.0 
DO  25  I « 1 .IMAX 
IF  (M.EQ.1)  EVIS  - EVIINF(I) 

IF  (M.EQ.1)  GO  TO  5 
TEM  « DEXP(THETAI(I)/TSG) 

EVIS  * (R*THETAI(I))/(MUI(I)*(TEM-1.0))*FI(I) 

DEVIS  » (R*FI(I)*THETAI(I)**2)/(MUI(I)*TSG**2) * (TEM/ (TEM- 1 . 0) **2 ) 
5 SUMG  « 0.0 
SUMGE  « 0.0 
DSUMGE  * 0.0 
LI  I « LI ( I ) 

C 

DO  10  L « 1 ,LII 

TEM1  « DEXP ( - EPSIIL(L, I )/TSG) 

SUMG  « SUMG  + TEM1*GIL(L, I ) 

SUMGE  « SUMGE  + TEM1 *GI L( L , I ) *EPSI I L( L , I ) 

10  DSUMGE  « DSUMGE  + TEM1 *GI L ( L , I ) *EPSI I L( L , I ) **2 
EEIS  « ( R/MUI (!))*( SUMGE/SUMG ) 

DEEIS  - R/MUI ( I ) * ( ( ( SUMG*DSUMGE/TSG**2 ) - ( SUMGE/TSG ) **2 ) 

* /SUMG**2 ) 

EIS  = (1 .5*R*TSG)/MUI(I)  + ( F I ( I ) *R*TSG )/MUI ( I ) + EVIS  + EEIS 

* + DELHI ( I )/MUI ( I ) 

DEIS  = 1 . 5*R/MUI  ( I ) + FI  ( I ) ♦R/MUI  ( I ) + DEVIS  + DEEIS 
ES  = ES  + El S*CI INF ( I ) 

DES  = DES  + DEIS-CIINF(I) 

25  CONTINUE 
C 

FAC  = DSQRT(OMEGSQ  - 2 . 0*LAMSQ* ( DELTA  - ES)) 

FIN  = ( 2 . 0*MUINF* (DELTA  - ES ) *FAC )/( R* ( OMEGA  + FAC)) 

FTS  = TSG  - FIN 

FAC  1 = R* ( OMEGA+FAC ) * (MUINF* (DELTA-ES)*(2. 0/FAC )*LAMSQ*DES  - 

* 2 .0*FAC*MUINF*DES)  - 2 . 0«MUINF * ( DELTA-ES ) *R*LAMSQ*DES 
FAC2  = R**2* ( OMEGA  + FAC)**2 

DFTS  =1.0-  FAC1/FAC2 
IF  (DFTS. EQ. 0.0)  THEN 
ICODE  = 2 
RETURN 
ENDIF 

TSG 1 = TSG  - ( FTS/DFTS ) 
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DELTS  * DABS(TSG1  - TSG) 

TSG  » TSG1 

IF  ( ITER. GE. MAXI)  THEN 
ICODE  « 1 
RETURN 
END  IF 

IF  (DELTS. GT. T0L1 ) THEN 
ITER1  - ITER 
GO  TO  1 
END  IF 

ITER2  - ITER1  + 10 

IF  (DELTS. LE.T0L2. OR. ITER. GE.ITER2)  RETURN 
GO  TO  1 
END 
C 

c 

c 

SUBROUTINE  CHECK 
C 

C CHECK  CALLED  BY  CALITH  TO  MAKE  DECISION  TO  ACCEPT  ANSWERS 
C 

C IF  ACCEPTABLE  ; SET  ELB  ■ 0 AND  RETURN 

C IF  NOT  ACCEPTABLE  ; MODIFY  SPEC  AND  Cl  ; SET  ELB  « 1.0  AND  RETURN 

C 

IMPLICIT  REAL*8(A-H,0-Z) 

COMMON  /A  1/  TE1 ,TE2,M, IX, IMAX, I PS I .MODEL 
COMMON  /A2/  P( 500) , DPDX ( 500) , VARI ( 500) 

COMMON  / A3/  EVIINF(25) ,THETAI(25) , MUI (25 ) , FI ( 25 ) .DELHI (25) , 

* CIINF(25),LI(25) 

COMMON  / A4/  R.MUINF, DELTA. LAMSO . OMEGSO . OMEGA, MU. T.U.TINF 
COMMON  /A5/  EPSIIL(20,25),GIL(20,25) , CID( 200, 50) 

COMMON  /A6/  VAR ( 52 ) , CUVAR (52) ,DER(51 ) 

COMMON  /A  1 3/  SP.TS.DELX.ZSTERM.I ZTERM, NSR , MW 
COMMON  /A  17/  ELB , SPEC , CJ, TPREV, HPREV, HCHECK , TCHECK 
COMMON  /A  18/  ITNEG , I EXP 
REAL*8  MUI , MU, MUINF, LAMSO 
EQUIVALENCE  (CUVAR(2),H) 

C 

IF  (IEXP.NE. 1)  GO  TO  1 
GO  TO  15 

C REDUCE  COMPUTING  INTERVAL  TO  TRY  AND  AVOID  EXP  ERROR  STOP 

1 IF  (ITNEG. EO.O)  GO  TO  4 

C E.GT.H  SOMETIMES  LEADS  TO  NEG  T— REDUCE  INTERVAL  TO  TRY  TO  AVOID  INSTABILITY 
GO  TO  15 

4 IMAXP1  - IMAX  + 1 
DO  10  I ■ 3.IMAXP1 

C CUVAR ( 2 ) « H MAY  BE  NEGATIVE 

IF  ( CUVAR ( I ) . LT .0.0)  WRITE(15,5)  I , IX , CUVAR( I ) 

IF  (CUVAR(I ) .LT.O.O)  GO  TO  15 

5 FORMAT(  IX, 'NEG  Cl  AT  I ■ ',13, IX, 'IX  * ' , 1 3 , 1 X , ' CUVAR(  I ) = ', 

* E 12 . 5 , 1 X , 'IN  SUB  CHECK'/) 

10  CONTINUE 

IF  (IX.LT.3)  GO  TO  30 

IF  ( ( IPSI . EQ . (NSR+ 1 ) ) . AND . ( IX . LT . (NSR+3) ) ) GO  TO  30 
IF  (DABS(TPREV  - T )/T . LT . TCHECK ) GO  TO  25 
WR I T E ( 15,11) 

11  FORMAT( IX, 'CHECK  ABS( TPREV-T )/T . GE . TCHECKT  IN  SUB  CHECK'/) 

15  IF  (SPEC.GT. 1 .OE-15)  GO  TO  20 

WRITE(15, *) 'SPEC  .LT.  1. OE-15  IN  SUB  CHECK  STOP  30' 

STOP 

C STOP  30 

C REDUCE  INTERVAL 

20  SPEC  * SPEC/4.0 
CJ  « SPEC 
ELB  ■=  1.0 

WRITE  ( 15,22)  SPEC. IPSI. IX, T, TPREV, H, HPREV, I EXP, ITNEG 
22  FORMAT( IX, 'REDUCED  SPEC  = ' , E9 . 4 , 2X , ' IPSI  = ',I3,2X,'IX  * ',13, 

* 2X,'T  « ' .E9.4.2X, 'TPREV  = ' , E9 .4 , /,  IX,  'H  * '.E9.4.3X, 

* 'HPREV  = ' .E9.4.3X, 'IEXP  = ', 13 , 3X ,' ITNEG  = ',13.'  IN  CHECK'/) 

ITNEG  * 0 

IEXP  = 0 
RETURN 

25  IF  (DABS( (HPREV  - H)/H) .GT .HCHECK)  WRITE(15,27) 

27  FORMAT( IX, 'CHECK  ABS( (HPREV-H)/H) . GT .HCHECKT  IN  SUB  CHECK'/) 

IF  (DABS( (HPREV  - H)/H) . GT . HCHECK)  GO  TO  15 
C ACCEPTABLE 

30  TPREV  = T 
HPREV  = H 
ELB  = 0.0 
RETURN 


oooooooooooo  ooo 


END 


SUBROUTINE  SHOCKG  (NXPSTM.ITK) 


SUBROUTINE  SHOCKG  CALLED  BY  MAIN  AND  MUST  BE  SUPPLIED  BY  USER. 
X.ZS.RS.RC. COST, SINT  FOR  EACH  X FROM  0.0  TO  X AT  ZSTERM  IN  INCREMENTS 
OF  (DELX/NSR)  TO  DELX  AND  INCREMENTS  OF  DELX  THEREAFTER. 


X « DISTANCE  ALONG  SHOCK 

ZS  » DISTANCE  ALONG  SHOCK  AXIS  OF  SYMMETRY 

RS  ■ RADIUS  OF  SHOCK 

RC  « RADIUS  OF  CURVATURE  OF  SHOCK 

COST  ■ COS  OF  ANGLE  OF  ATTACK 

SINT  » SIN  OF  ANGLE  OF  ATTACK 


C 


5 


C 


C 


10 

c 


25 


C 

30 


35 


IMPLICIT  REAL*8(A-H,0-Z) 

COMMON  /A9/  EVIS(25) ,XPST( 100) 

COMMON  /A 12/  SINTM( 1500) , COSTM( 1 500) , RSM( 1 500) , RCM( 1500) , X 1 ( 1 500) 

* , ZSM( 1500) 

COMMON  /A 13/  SP.TS, DELX. ZSTERM, IZTERM.NSR, MW 

DIMENSION  ZDUM( 501 ) ,RSDUM(501 ) ,RCDUM(501 ) ,XC(501 ) ,C0DUM(501 ) , 

* SIDUM(501 ) 

Rs/L  * SORT ( 2*R*Zs/L  - Bs* ( Zs/L ) **2 ) WHERE:  L * 1.0  cm 

ITK  - O 

EL  « 1.0 

R « 230.0 

BS  - -4.0 

DO  5 I « 2,501 

ZDUM(I)  « ( I- 1 ) *ZSTERM/500 

ZDUM(1)  « 0.0 

RSOUM( 1)  » 0.0 

XC(1)  « 0.0 

CODUM(I)  « 0.0 

SIDUM(I)  « 1.0 

RCDUM(I)  « 230.0 

DO  10  I * 2,501 

ZSND  « ZDUM( I )/EL 

RSDUM(I)  * DSORT ( 2 . *R*ZSND  - BS*ZSND**2) 

C « 1 . 0/ ( R - BS*ZSND)**2 

Cl  - DSQRT(C*RSDUM(I)**2  + 1.0) 

XC(I)  « RSDUM( I )/2 . *C1  + 1 ./(2.*DSQRT(C) ) *DLOG( RSDUM( I )*DSORT(C) 

* + Cl) 

D1  * (R  - BS*ZSND )/RSDUM( I ) 

D2  « -( (R  - BS*ZSND ) **2/RSDUM( I )**3)-  BS/RSDUM(I) 

THETA  » ATAN(DI) 

SIDUM(I)  « DSIN(THETA) 

CODUM(I)  « DCOS( THETA) 

RCDUM(I)  « (1.0  + D1**2)**1 . 5/DABS (D2 ) 

DIMENSIONAL I ZED  QUANTITIES 

RCDUM(I)  « EL*RCDUM( I ) 

XC(I)  « EL*XC( I ) 

RSDUM(I)  ■ EL*RSDUM( I ) 

CONTINUE 

WRITE(8 , 25 ) 

FORMAT ( 5X , ' X ' , 1 IX . ' ZS ' , 10X , ' RS ' , 10X , ' RC ' ,9X, 'COST' , 8X . 'SINT'/) 

NOX  « O 
M ■=  1 
NZS  « 501 

INTERPOLATE  SHOCK  VALUES  TO  X SHOCK  COORDINATE 

NOX  * NOX  + 1 

IF  ( NOX . LT . ( NSR+2 ) ) X = X + DELX/NSR 
IF  (NOX.EO. 1 ) X = 0.0 
IF  ( NOX . GT . ( NSR+ 1 ) ) X = X + DELX 
CALL  FTLUP  (X , ZS , M, NZS , XC. ZDUM ) 

CALL  FTLUP  (X , RS , M, NZS , XC , RSDUM ) 

CALL  FTLUP  ( X , RC , M, NZS , XC , RCDUM ) 

CALL  FTLUP  ( X , COST , M , NZS , XC , CODUM) 

CALL  FTLUP  (X , SINT , M, NZS , XC , SIDUM ) 

WRITE ( 8 , 35 ) X.ZS.RS.RC, COST , S I NT , NOX 
FORMAT (1X,6(E10.4,2X).I4) 

SINTM(NOX)  = SINT 
COSTM(NOX)  « COST 
RSM(NOX)  = RS 
RCM(NOX)  = RC 
XI (NOX)  = X 

ZSM(NOX)  = ZS  n 


ooooo  o o o 


36 


37 


C 

40 


C 

C IF 
C IF 
C 


997 

998 


999 

1000 
C 

1 

2 

3 
C 

4 
C 

5 


6 

65 


DO  36  IT  * 2.NXPSTM 

IF  (DABS( XPST (IT)  - X ) . GT . 1 . 0E-06 ) GO  TO  36 

ITK  * ITK  + 1 

CONTINUE 

IF  (ZS.GE.O.O)  GO  TO  40 
WRITE ( 15,37)  ZS 

FORMAT ( IX , ' ZS  SHOULD  BE  GREATER  THAN  0.0  : ZS  * '.E10.5, 

/,  IX,  # STOP  13  V) 

STOP 

STOP  13 

IF  (ZS.LT.ZSTERM)  GO  TO  30 

IZTERM  * NOX 

RETURN 

END 


SUBROUTINE  CALITH  (N, Cl MAX , PHMAX ) 

IN  THE  CALITH  VERSION  OF  CALINT,  THE  VARIABLE  IN  VAR(2)  AND 
CUVAR ( 2 ) MAY  BE  + OR  VALUES  OF  OTHER  DEPENDENT  VARIABLES 

ARE  EXPECTED  TO  BE  POSITIVE.  10-69 

IMPLICIT  REAL*8(A-H,0-Z) 

COMMON  /A  1/  TE1 , TE2 , M , IX , I MAX , IPSI f MODEL 
COMMON  / A2/  P( 500) , DPDX( 500) , VARI ( 500) 

COMMON  / A3/  E VI INF (25) .THETA I (25) ,MUI ( 25 ) . FI ( 25 ) , DELHI ( 25 ) , 

* CIINF(25) ,LI(25) 

COMMON  / A4/  R t MU INF , DELTA , LAMSO , OMEGSO , OMEGA  , MU , T , U , TINF 
COMMON  / A5/  EPSI I L ( 20 , 25 ) , GI L ( 20 , 25 ) , CID( 200 , 50) 

COMMON  / A6/  VAR ( 52) , CUVAR (52) ,DER(51 ) 

COMMON  /A7/  MJ ( 50) , E J( 50 ) , AJ( 50 ) , BJ( 50) , DI RECT( 50 ) 

COMMON  / A8/  TVI (25) .DGENI (25) (BX (25) ,NI (25) 

COMMON  / A 10/  NUI J( 26 ,50) , AI J( 25 , 50) , NUPI J( 25 , 50) 

COMMON  /All/  SIGIK(25,25),ALPIK(25,25),BETAIK(25,25) 

COMMON  /A  1 7/  ELB, SPEC.CJ.TPREV, HPREV , HCHECK , TCHECK 
COMMON  /A  19/  ELE1(51),ELE2(51),NERR 
REAL*8  MUItMUfMUINF, LAMSO 

DIMENSION  F 1 ( 5 1 ) , F2 ( 5 1 ) . F3( 5 1 ) , CAPF 1 ( 5 1 ) t CAPF2( 5 1 ) , CAPF3(  5 1 ) 

* , P 1 ( 5 1 ) , PH( 5 1 ) . DELTY (51 ) , Y3( 5 1 )#Y4(51 ) . F4( 5 1 ) , Y2 ( 5 1 ) 

CjJ  OR  N IS  EQUAL  TO  ZERO  : NERR  * 1 

ELE 1 IS  LESS  THAN  OR  EQUAL  TO  ELE2  : NERR  = 2 

TEST  INPUT 

FN  * N 

TEST  * C J*FN 
IF  (TEST)  998  * 997 , 998 
NERR  * 1 
RETURN 

DO  999  I * 1 , N 

IF  ( (ELE 1(1)  - ELE2 ( I ) ) . LE . 0 . 0)  THEN 
NERR  « 2 
RETURN 
ENDIF 
CONTINUE 
IF  (SPEC)  5,1,5 

SECTION  FOR  INITIALIZATION  COMPUTATION  OF  DERIVATIVES 

SPEC  * CJ 
ICONT  * 1 
N1  * N + 1 
DO  3 I ■ 1,N1 
CUVAR ( I ) * VAR ( I ) 

CALL  BASIC 

RETURN  WITH  DERIVATIVES  IN  DER 

DO  4 I * 1,N 
F 1 ( I ) * DER(I) 

RETURN 

COMPUTE  Y 2 , X2 

CUVAR ( 1 ) * VAR(  1 ) + CJ/2.0 
DO  6 I * 1 ,N 
11=1+1 

Y2 ( I ) = VAR (II)  + CU/2 . 0*F 1 ( I ) 

IF  (I .EQ. 1 ) GO  TO  6 
IF  ( Y2 ( I ) ) 65,6,6 
CUVAR (II)  = Y2 ( I ) 

GO  TO  66 
SPEC  = CJ 
CJ  = CJ/2.0 

IF  (CJ.LE. 1 .OE-25)  THEN 
WRITE ( 15,25)  CJ  ^ . 


25 


C 


66 

C 


C 


7 

C 

C 


c 


8 


9 

91 

83 


103 

84 

85 


95 


10 

C 


102 


101 
1 1 


C 

13 


94 

955 

96 


C 

15 

16 
C 


165 

C 

17 


175 


FORMAT ( IX 
STOP 
ENDIF 
GO  TO  5 

CALL  BASIC 


'MIN.  INTEGRATION  STEP  OF  '.E12.4.'  WAS  REACHED'/) 

CALL  BASIC  TO  EVALUATE  F2 
RETURN 


DO  7 I • 1,N 
11*1+1 
F2 ( I ) « DER(I) 

COMPUTE  Y3 

Y3 ( I ) - VAR (II)  + C J/ 2 . 0*F2 (I ) 

IF  (I.EO. 1)  GO  TO  7 
IF  ( Y3 ( I ) ) 65.7.7 
CUVAR(II)  * Y3 ( I ) 

CALL  BASIC  TO  EVALUATE  F3 


CALL  BASIC 


RETURN 


DO  10  I ■ 1.N 
F3 ( I ) « DER(I) 

COMPUTE  P .PH  AND  CAP  F TERMS 

IF  ( Y3 ( I ) - Y2 ( I ) ) 9.8,9 
P 1 ( I ) * 0.0 
GO  TO  91 

PI ( I ) - - ( ( F3 ( I ) - F2(I))/(Y3(I)  - Y2 ( I ) ) ) 

PH( I ) * P1(I)*CJ 
IF  (PH(I))  83.83.103 
PH( I ) = 0.0 
P 1 ( I ) * 0.0 
GO  TO  84 

21  * DABS ( Y3 ( I ) - Y2(I))/( (DABS ( Y 3 ( I ) ) + DABS ( Y2 ( I ) ) )/2 . 0 ) 

IF  ( Z 1 - 0.5E-04)  83,83,84 
IF  ( PH ( I ) -0.1)  85,85,95 

CAPFI(I)  * 1.0  - PH( I )/2 . 0 + PH(I)**2/6.0  - PH( I ) * *3/24 . 0 
CAPF2  ( I ) = 0.5  - PH(I)/6..0  + PH(  I ) * *2/24 . 0 - PH  ( I ) **3/ 1 20 . 0 
CAPF3 ( I ) - 1./6.-  PH(I)/24.  + PH( I ) **2/ 1 20 . - PH( I ) **3/720 . 

GO  TO  10 

CAPF 1(1)  * (DEXP ( -PH( I ) ) - 1.0)/(-  PH(I)) 

CAPF2 ( I ) * ( CAPF 1(1)  - 1.0)/(-  PH(I)) 

CAPF3 ( I ) * ( CAPF2 ( I ) - 0.5)/(-  PH(I)) 

CONTINUE 

IS  PH  BETWEEN  ELE2  AND  ELE 1 

IF  (ICONT  - 1 ) 101 . 101 , 102 

ICONT  = ICONT  - 1 

SPEC  * CJ 

GO  TO  17 

DO  11  I * 1.N 

IF  (DABS(PH( I ) ) - ELE 1(1))  11,11,13 
CONTINUE 
SPEC  * CJ 
GO  TO  15 

HALVE  INTERVAL  AND  DOUBLE  PH  RANGE 


DO  96  I * 1 ,N 

ELEI(I)  = ELE 1 ( I ) *2 . 0 

IF  ( ELE 1 ( I ) - PHMAX ) 94,94,955 

E LE2 ( I ) * ELE2 ( I ) *2 . 0 

GO  TO  96 

ELEI(I)  * ELE 1 ( I )/2 .0 

CONTINUE 

SPEC  * CJ 

CJ  = CJ/2.0 

ICONT  = 3 

GO  TO  5 

RETURN  TO  RECOMPUTE  INTERVAL 

DO  16  I = 1 , N 

IF  (DABS(PH(I))  - ELE2( I ) ) 16,17,17 
CONTINUE 

DOUBLE  INTERVAL 

CJ  = 2 . 0*C J 

IF  (CJ  - CIMAX)  17,17, 165 
CJ  = CIMAX 

COMPUTE  Y4,X4 

DO  18  I 2 1 , N 
11=1+1 

CUVAR(II)  = VAR ( II)  + SPEC*(F3( I )*(2 .0*CAPF2( I ) ) + F1(I)* 

( CAPF  1(1)  - 2 . 0*CAPF2 ( I ) ) + F2 ( I ) *PH( I ) *CAPF2( I ) ) 

IF  (I .EQ. 1 ) GO  TO  18 
IF  (CUVAR(I 1 ) ) 175,18,18 
CJ  = SPEC 
CJ  * CJ/2.0 


<rx  o 
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GO  TO  5 

18  Y4( I ) « CUVAR ( II) 

CUVAR(I)  « VAR ( 1 ) + SPEC 

C CALL  BASIC  TO  EVALUATE  F4 

CALL  BASIC 

C RETURN 

DO  20  I * 1 , N 
II  « I + 1 
F4( I ) - DER(I) 

COMPUTE  DELTA  Y 

DELTY(I)  ■ SPEC*(F1(I)*CAPF1(I)+(-3.0*(F1(I)+P1(I)*VAR(I1))+2.0* 

* (F2(I)+P1(I)*Y2(I))  + 2 .0* (F3(I)+P1(I)*Y3(I))  - F4(I)  - PI  ( I ) * 

* Y4( I ) )*CAPF2( I ) + 4.0*((F1(I)+P1(I)*VAR(I1))  - (F2(I  )+P1 (I )* 

* Y2( I ) ) - ( F3( I )+P1 (I)*Y3(I))  + (F4(I)+P1(I)*Y4(I)) ) *CAPF3( I ) ) 

COMPUTE  Y + DELTA  Y 

20  CUVAR ( II)  « VAR(II)  + DELTY(I) 

CALL  CHECK  FOR  DECISION  TO  ACCEPT  OR  RECOMPUTE  INTERVAL 

CALL  CHECK 
IF  (ELB)  21.21,23 

UPDATE  Y VALUES 

21  N1  « N + 1 
DO  22  I « 2,N1 
II  • I - 1 

22  VAR(I)  - VAR ( I ) + DELTY(II) 

VAR  ( 1 ) - VAR( 1 ) + SPEC 

RETURN  TO  COMPUTE  DERIVATIVES  AT  Y + DELTA  Y 

GO  TO  2 

RETURN  TO  RECOMPUTE  INTERVAL 

23  GO  TO  5 
END 


SUBROUTINE  FTLUP  (X, Y . M. N. VARI , VARD ) 

THIS  SUBROUTINE  IS  A MODIFICATION  OF  LIBRARY  INTERPOLATION 
SUBROUTINE  FTLUP  REVISED  7-7-69 

IMPLICIT  REAL*8( A-H.0-2) 

DIMENSION  VARI ( 5) . VARD( 5),V(3),YY(2),II( 100) 

INITIALIZE  ALL  INTERVAL  POINTERS  TO  -1.0  FOR  MONOTONICITY  CHECK 
DO  4 d = 1 „ lOO 

4 11(d)  * -1 
MA  = IABS(M) 

ASSIGN  INTERVAL  POINTER  FOR  GIVEN  VARI  TABLE  ; THE  SAME  POINTER 
WILL  BE  USED  ON  A GIVEN  VARI  TABLE  EVERY  TIME 

LOCF  « VARI ( 1 ) 

LI  *=  MOD(LOCF.  100)  + 1 

I « 1 1 ( LI ) 

IF  (I.GE.O)  GO  TO  10 
IF  (N.LT.2)  GO  TO  10 
C MONOTONICITY  CHECK 

IF  (VARI  (2)  - VARI(O)  1,1,3 

C ERROR  IN  MONOTDNICITY 

2 K « LOCF 

WRITE( 15, 102)  J.K 

102  FORMAT ( IX, 'TABLE  BELOW  OUT  OF  ORDER  FOR  FTLUP  AT  POSITION 
» 15 , // , IX , ' X TABLE  IS  STORED  IN  LOCATION' , 15//) 

DO  103  d « 1.N 

103  WRITE ( 15 , * ) VARI (d) , VARD(d) 

STOP 

C MONOTONIC  DECREASING 

1 DO  5 d * 2,N 

IF  (VARI ( d)  - VARI (d-1 ) ) 5,2,2 

5 CONTINUE 
GO  TO  10 

C MONOTONIC  INCREASING 

3 DO  6 d = 2,N 

IF  (VARI (d)  - VARI (d-1 ) ) 2,2,6 

6 CONTINUE 

C INTERPOLATION 

10  IF  (I.LE.O)  I = 1 

IF  (I.GE.N)  I = N - 1 
IF  (N.LE.1)  GO  TO  8 
IF  (MA.NE.O)  GO  TO  99 

8 Y = VARD ( 1 ) 

GO  TO  800 


c 


ZERO  ORDER 


o o o o o o 


c 


99 

C 

40 
C 

41 


61 

C 


C 

200 


c 


201 

209 

702 


800 


LOCATE  I INTERVAL  ( X ( I ) .LE.X.LT.X(I+1)) 

IF  ((VARX(I)  - X ) * ( VARI ( 1+ 1 ) - X))  61,61,40 

IN  GIVES  DIRECTION  FOR  SEARCH  INTERVALS 

SIGN1  - 1.0 

IN  ■ SIGN( SXGN1 , ( VARI ( 1+1 ) - VARI(I))*(X  - VARI(I))) 

IF  X OUTSIDE  ENDPOINTS,  EXTRAPOLATE  FROM  END  INTERVAL 
IF  ((I+IN) .LE.O)  GO  TO  61 
IF  ((I+IN) .GE.N)  GO  TO  61 
I - I + IN 

IF  ( ( VARI ( I ) - X ) * (VARI ( 1 + 1 ) - X))  61,61,41 
IF  (MA.E0.2)  GO  TO  200 

FIRST  ORDER 

Y « ( VARD( I ) * ( VARI ( 1+ 1 ) - X)  - VARD( 1+1 )*( VARI ( I ) - X))/ 

( VARI ( 1+ 1 ) - VARI ( I ) ) 

GO  TO  800 

SECOND  ORDER 

IF  (N.E0.2)  GO  TO  2 
IF  (I.EO.(N-I))  GO  TO  209 
IF  (X.EQ.1)  GO  TO  201 

PICK  THIRD  POINT 

SK  - VARI (1+1)  - VARI ( I ) 

IF  ( ( SK* ( X - VARI (1-1))). LT. (SK*(VARI (1+2)  - X)))  GO  TO  209 
L « I 
GO  TO  702 
L « I - 1 

V( 1 ) « VARI(L)  - X 
V( 2 ) - VARIU+1)  - X 
V( 3 ) * VARI ( L+2)  - X 

YY ( 1 ) * ( VARD (L)*V(2) -VARD( L+1 )*V( 1 ) )/(VARI(L+1 )-VARl(L) ) 

YY(2 ) = (VARD (L+1 )*V(3)-VARD(L+2)*V(2) )/( VARI (L+2)-VARI(L+1 )) 

Y = ( YY( 1 ) *V( 3 ) - YY(2)*V( 1 ) )/(VARI (L+2)  - VARI(L)) 

1 1 ( LI ) * I 

RETURN 

END 


SUBROUTINE  F0FT23  (MAXI , TOL 1 . T0L2 . ICODE , TSG, 101 , 102 , 103) 

CALLED  BY  MAIN  TO  EVALUATE  TS  BY  NEWTON  ITERATION  TECHNIQUE 
IMPLICIT  REAL*8(A“H,0~Z) 

COMMON  /A  1 / TE1;TE2,M,IX, I MAX , IPSI , MODEL 
COMMON  / A2/  P(500),DPDX(500), VARI (500) 

COMMON  / A3/  EVIINF(25) , THETA I (25) , MU 1(25) , FI (25) ,DELHI(25) , 

* C I I NF ( 25 ) , LI ( 25 ) 

COMMON  /A4/  R, MUINF, DELTA, LAMSQ , OMEGSQ , OMEGA, MU, T,U,TINF 
COMMON  / A5/  EPSIIL(20,25) , GIL (20, 25 ) ,CID( 200 , 50) 

COMMON  / A6/  VAR ( 52 ) , CUVAR (52) , DER ( 5 1 ) 

DIMENSION  SUMGM(25) ,EISM(25) ,DEISM(25) 

REAL*8  MUI .LAMSQ. MUINF, MU 

W * 1 .0 

DO  1 I = 1.IMAX 

1 CXD(XX.X)  c CIINF(I) 

ITER  * 0 

2 ITER  * ITER  + 1 

IF  (ITER.EO. 1)  THEN 
ES  *=  DELTA 

PS  * DSQRT ( OMEGSO  - 2 . * LAMSQ* (DELTA  - ES)) 

ENDIF 

IF  (101 .EQ. 1)  THEN 
TVIB  = TINF 
ELSE 

TVIB  = TSG 
ENDIF 

IF  (102. EO. 1)  THEN 
TEL  = TINF 
ELSE 

TEL  = TSG 
ENDIF 

ES  = 0.0 

DES  = 0.0 

DO  25  I = 1.IMAX 

IF  (M.E0.1)  EVIS  = EVIINF(I) 

IF  (M. EO. 1 ) GO  TO  5 

TEM  = DEXP (THETA  I ( I )/TVIB ) 

EVIS  = (R*THETAI (I ))/(MUI (I )*(TEM  - 1.0))^FI(I) 

DEVIS  = (R*FI(I)*THETAI(I ) **2 )/ (MUI ( I ) *TVIB**2 ) * ( TEM/ ( TEM- 1 .0)*^2) 


IF  (I.EQ.1)  QVN 
IF  (I.EQ.2)  QVO 
SUMGM(I)  - 0.0 
SUMGE  -0.0 
DSUMGE  >0.0 
LII  - LI ( I ) 


1.0/C1.0  - DEXP(-THETAI ( I )/TVIB ) ) 
1.0/(1.0  - DEXP(-THETAI ( I )/TVIB) ) 


00  10  L * 1.LII 

TEM1  - DEXP(-EPSIIL(L. I)/TEL) 

SUMGM(I)  « SUMGM(I)  + TEM1*GIL(L, I ) 

SUMGE  « SUMGE  + TEM1*GIL( L, I ) *EPSI I L(L , I ) 

DSUMGE  - DSUMGE  + TEM1*GIL(L, I )*EPSIIL(L, I )**2 
OROTN  > TSG/5.8 
QROTO  > TSG/4.2 

EEIS  - (R/MUI ( I ) )*(SUMGE/SUMGM( I ) ) 

DEEIS  - R/MUI (!)*(( (SUMGM( I )*DSUMGE/TEL**2)  - (SUMGE/TEL)**2) 

* /SUMGM(I)**2) 

EISM(I)  - ( 1 . 5»R*TSG)/MUI ( I ) + (FI (I )*R*TSG)/MUI ( I ) + EVIS  + EEIS 

* + DELHI ( I )/MUI ( I ) 

DEISM(I)  - 1 . 5*R/MUI ( I ) + FI ( I )*R/MUI ( I ) + DEVIS  + DEEIS 
CONTINUE 

BETA  FOR  OXYGEN 


IF  (103. EQ. 2)  THEN 
TD  • 59500.0 

FI  - CIINF (2 )*MUINF/MUI (2) 

CIA  - TD/TSG 

CIA  > DEXP(C1A/2 .0) 

C1B  « 8 . 8568195* ( 1 . - Cl INF(  1 ) )*C1 A*( 1 . /(TSG**2 . 5) ) 

Cl  » C1A*2.O*MUINF*PS*C1B*QV0*QR0T0*(SUMGM(2)/(SUMGM(4)**2))/R 
BETAO  « ((FI-1.)  + DSQRT ((1.-F1)**2  + 4 . *( F 1+C1 ) ) )/( 2 . * ( F 1+C1 ) ) 

BETAN  = 0.0 
ENDIF 

BETA  FOR  NITROGEN  AND  OXYGEN 


IF  (103. EQ. 3)  THEN 
BETAN  = . 1 
BETAO  = 1.0 
TON  - 113500.0 
TDO  = 59500.0 

F 1 A - 8.8568195*0.  - Cl INF( 1 ) )*DEXP(TDO/TSG)* ( 1 ,/(TSG**2 . 5) ) 

F2A  - 12.36681*0.  - Cl INF(2)  )*DEXP(TDN/TSG)*( 1 . /(TSG**2 . 5 ) ) 

FI  * 2 . 0*MUINF*PS*F 1 A*QVO*QROTO*( SUMGM(2 )/ ( SUMGM(4)**2 ) )/R 
F2  « 2 . 0*MUINF*PS*F2A*0VN*QR0TN* (SUMGM( 1 )/ (SUMGM(3)**2) )/R 
A « ((1.  - BETA0**2)  + BETAN* ( 1 . - BETAO) )/(BETA0**2)  - FI 
B “ ((1.  - BETAN**2 ) + BETA0*(1.  - BETAN) )/(BETAN**2)  - F2 
ABO  = (BETAN'BETAO  - 2.*(1.  + BETAN) )/(BETA0**3) 

ABN  • (1.  - BETAO)/ (BETAO **2) 

BBO  - (1.  - BETAN )/(BETAN**2 ) 

BBN  * (BETAN'BETAO  - 2.*(1.  + BETAO) )/(BETAN**3) 

DEN  * ABO*BBN  - BBO*ABN 
DBO  = ( -A*BBN  + B*ABN)/DEN 
DBN  » ( -B*ABO  + A*BBO)/DEN 
BETAN  - BETAN  + DBN 
BETAO  * BETAO  + DBO 

IF  ( (DABS(DBO) .GT. .OOOOI ) .OR. (DABS(DBN) .GT. .00001 ) ) GO  TO  30 
ENDIF 

DISSOCIATING  CONCENTRATIONS  ACROSS  THE  SHOCK 
CID( IX , 2 ) * (1.0  - BETA0)*CIINF(2) 

CID( IX , 4 ) * BETA0*CIINF(2) 

CID(IX.I)  = 0.0  - BETAN )*CI INF ( 1 ) 

CID( IX , 3)  » BETAN*CI INF ( 1 ) 


DO  35  I * 1 , I MAX 

ES  * ES  + EISM(I)*CID(IX,I) 

DES  * DES  + DEISM(I)*CID(IX,I) 

FAC  * DSQRT (OMEGSO  - 2 .0*LAMSQ*(DELTA  - ES)) 

FIN  * (2.0*MUINF*(DELTA  - ES)*FAC)/(R*(OMEGA  + FAC)) 

FTS  = TSG  - FIN 

FAC1  = R* (OMEGA+FAC)*(MUINF* (DELTA- ES )* ( 2 .0/FAC)*LAMSQ*DES  - 
* 2 . 0*FAC*MUINF*DES)  - 2 ,0*MUINF*(DELTA-ES)*R*LAMSO*DES 

FAC2  = R**2* ( OMEGA  + FAC)**2 
DFTS  = 1.0  - (FAC1/FAC2) 

PS  = FAC 

IF  (DFTS. EQ. 0.0)  THEN 
ICODE  = 2 
RETURN 
ENDIF 

TSG1  = TSG  - W* ( FTS/DFTS ) 

DELTS  = DABS(TSG1  - TSG) 

TSG  = TSG1 

IF  (ITER. GE. MAXI)  THEN 
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I CODE  * 1 
RETURN 
END  IF 

IF  (CELTS. GT.TOL1 ) THEN 
ITER1  » ITER 
GO  TO  2 
END  IF 

ITER2  » ITER1  + 10 

IF  (CELTS. LE.T0L2. OR. ITER. GE.ITER2)  RETURN 

GO.  TO  2 

END 


SUBROUTINE  OLRAO  (104,105.106,108,109,1010) 

IMPLICIT  REAL*8(A-H.0-Z) 

COMMON  /A  1 / TE1.TE2.M, IX. IMAX.IPSI, MODEL 

COMMON  / A3/  EVII NF (25), THETA I (25) ,MUI (25) ,FI(25) .DELHI ( 25 ) , 

* CIINF(25),LI(25) 

COMMON  / A5/  EPSIIL(20,25),GIL(20,25) , CID( 200, 50) 

COMMON  / A9/  EVI S ( 25 ) , XPST ( 100) 

COMMON  /RAD/  RCDN( 100, 10, 40) , RRHO( 100, 40) , TEMP( 100 , 40) 

* ,TSTAG.Y( 100,40) ,NXCON,NPTS( 100) 

COMMON  /RADC/  YBDY ( 100) . B( 100, 8 , 40) , OPTL( 100 , 8 . 40) 

COMMON  /RADO/  TEMPO( 100, 40) , ALPN( 100 , 40) , ALPO( 100 , 40) 

COMMON  /RADOL/  BETN( 100 , 40) , BETO( 100, 40) 

REAL*8  KAPPA ( 100,8.40) ,KAP( 100, 4 . 40) , KA( 100, 4 , 40) , MUI 
REAL*8  K11.K22.N.NN 
WRITE ( 8 , 1 ) 

1 FORMAT ( /// ' OLSTAD  RADIATION  MODEL') 

I F( 108 . EO . 0)  THEN 

I F ( 106 . EO . 0)  WRITE( 8 , 2 ) 

IF( 106 . EO . 1)  WRITE (8,3) 

END  IF 

2 FORMAT(/ ' BETA<=BETA(Te) ' ) 

3 FORMAT ( / ' BETA-BETA(Tt)' ) 

C NUMBER  DENSITIES 

DO  12  K=3 , NXCON 
DO  12  U-I.NPTS(K) 

DO  10  I I B 1 , I MAX 
XXX=RRHO( K , J ) *6 . 023D+23 
XXX=XXX*RCON(K, II ,U)/MUI(II) 

10  RCON(K,II,J)*XXX 

12  CONTINUE 

IF(IQ10.EO.O)GO  TO  15 
DO  14  K=3. NXCON 
NUP«NPTS(K)-1 
DO  14  J* 1 , NUP 
FNA*RCON(K, 3, J) 

FNI *RCON( K . 9 , J ) 

FNE“RCON( K , 7 , J ) 

FNM*RCON(K, 1 , J) 

El c2 . 3322D- 1 1 
FAV*6 . 023D23 
SA* 1 . 52D- 15 
TE*TEMP(K, J) 

16  SM=0 . 5355D- 19*TE+0 . 696D- 15 
SI “ 1 ,53614D08*(TE**3)/FNE 
SI “DSQRT (SI ) 

SI ■ ( 4 . 38384D-06/ (TE»*2)) *DLOG( SI ) 

FKF=1 . 1D32*(TE**(-3. 14D0) )*DEXP(-1 . 69D05/TE ) 

FKB  = 2 . 2D 20* (TE  ** ( -4 . 5D00) ) * 1 .D20 
WEA“FKF*FNA-FKB*FNE* ( FNI/FAV) 

SX»FNA*SA+FNI*SI+FNM/2.0D0*SM 
W1 =WEA 

T 1 “TEMPO ( K , d ) - 1 . 23357D- 10/SX/DSORT(TE )*(WEA*EI+W1*3.45D-16*TE) 
IF(T 1 . LT .0 . ODOO)T 1 *0 .ODO 
TT=DABS(TE-T  1 ) 

TE=TE+(T1-TE)*0. 125D00 

I F ( TT . GT . 1 . ODOO ) GO  TO  16 

I F ( TE . GT . TEMPO ( K , J ) )TE=TEMPO(K , J ) 

TEMP(K, J)«TE 

14  CONTINUE 

15  CONTINUE 

C NONEQUILIBRIUM  RADIATION  CORRECTION 

IF  (I05.E0.0)  THEN 
DO  122  K=3, NXCON 
DO  122  J* 1 , NPTS ( K ) 

IF ( J . EO . NPTS ( K ) ) THEN 
ALPN(K, J)=0.D+00 


BETN(K, J)*0.D+00 
GO  TO  122 
ENDIF 
01-0. D+0 
02*0. D+0 
03-0. D+0 

DO  112  111*1, LI(3) 

112  Q1«Q1+GIL(III,3)*DEXP(-EPSIIL(III,3)/TEMP(K,J)) 

DO  113  m«1,LI(9) 

113  Q2«Q2+GIL(III,9)*DEXP(-EPSIIL(III,9)/TEMP(K, J)) 

DO  130  111*1, LI (1) 

130  Q3-Q3+GI L( III, 1 )*DEXP( -EPSI IL( 111,1 )/TEMP(K, J) ) 

RH0 1 *RC0N( K . 3 , J ) * 1 . 40 1D+0 1 /6 . 023D+23 
RH02-RC0N(K , 9 , J) * 1 . 4010+01/6 . 023D+23 
RH03*RC0N(K, 1 , U)»2 . 802D+01/6 .023D+23 
RH04 -RHO 1 +RH02+RH03 

OVIB* 1 . D+0/( 1 .D+0-DEXP(-3.39D+03/TEMP(K,J) ) ) 

OROT -TEMP( K . J )/5 . 8D+0 

C 1 -RH04*2 . 4701D+01 *0VIB*0R0T*03*DEXP( 1 . 135D+05/TEMP(K, J) ) 
C1-C1/(Q1**2*TEMP(K. J)**1 .5) 

C2-RH04*8.909D+06*01*DEXP( 1 .69D+05/TEMP(K. J) ) 
C2*C2/(02*TEMP(K. J)**1 .5) 

ALPHA-0. 5D+0 
BETA-0. 5D+0 

132  F«BETA**2*( 1 . D+O-ALPHA ) **2*C 1+BETA- 1 . D+0 

FA- -2 . D+0* BETA* *2* ( 1 . D+O-ALPHA ) *C 1 
FB*2 . D+O-BETA* ( 1 . D+O-ALPHA )**2*C 1+ 1 . D+0 
G-ALPHA**2*BETA*C2+ALPHA-1 .D+0 
GA*2 . D+0*ALPHA*BETA*C2+ 1 . D+0 
GB-ALPHA**2*C2 
DENOM«FA*GB-FB*GA 
DA-(-F*GB+G*FB)/DENOM 
DB* ( -G*FA+F*GA )/DENOM 
ALPHA-ALPHA+DA 
BETA-BETA+DB 

I F ( (DABS (DA ) . GT . 1 . D-05 ) . OR . ( DABS (DB ).GT.1.D-5))  GO  TO  132 
ALPH*RC0N(K , 9 , J)/ ( RCON(K, 9 , J )+RCON( K . 3 , J) ) 

BET*( RCON(K , 9 , U)+RCON( K , 3 , J) )/(2 . D+0*RC0N(K , 1,0)+ 

* RCON(K , 9 , J )+RCON(K , 3.0)) 

I F ( 106 . EQ . 1 ) GO  TO  1888 

BETN(K, J)-(BET**2/( 1 . D+O-BET ) ) * ( ( 1 . D+O-BETA )/(BETA**2 ) ) 

* *( ( 1 . D+O-ALPH) **2/ ( 1 . D+O-ALPHA )* *2 ) 

1888  ALPN(K,«J)*BET*(ALPH**2/(  1 .D+O-ALPH) ) 

» *( ( 1 . D+O-ALPHA )/ (BETA* ALPHA* *2 ) ) 

122  CONTINUE 

DO  142  K-3 , NXCON 
DO  142  J-I.NPTS(K) 

IF( J.EQ.NPTS(K) ) THEN 
ALPO(K , J) *0 . D+00 
BET0(K,d)=0.  D+00 
GO  TO  142 
ENDIF 

01- 0. D+0 

02- 0. D+0 
03*0. D+0 

DO  152  III-1.LK4) 

152  01*01 +GIL(IIIt4)*EXP(-EPSIIL(III, 4) /TEMP (K.J)) 

DO  153  1 1 1 * 1 , LI ( 10) 

153  02-02+GI L (III, 10) *DEXP( -EPSI IL( I I I , 10)/TEMP(K, J) ) 

DO  160  111=1 , LI ( 2 ) 

160  03*03+GIL( III , 2)*DEXP( -EPSI IL( III , 2 )/TEMP(K, J) ) 

RH01 «RCON( K , 4 , J ) * 1 . 600D+01/6 . 023D+23 
RH02*RC0N(K , 10 , U ) * 1 . 600D+01 /6 . 023D+23 
RH03*RC0N( K , 2 . U ) *3 . 200D+0 1/6 . 023D+23 
RH04-RH01+RH02+RH03 

OVIB* 1 . D+0/ ( 1 . D+0-DEXP(-2 . 27D+03/TEMP(K , J ) ) ) 

QROT*TEMP(K , J)/4 . 2D+0 

C 1 -RH04* 1 . 7725D+01 *QVIB*QR0T*Q3*DEXP( 5 . 950D+04/TEMP (K , J ) ) 
C1-C1/(01**2*TEMP(K.U)**1 .5) 

C2-RH04-7 . 801D+06*Q 1 *DEXP( 1 . 5BD+05/TEMP(K, J)  ) 
C2-C2/(02*TEMP(K, J)**1 .5) 

ALPHA-0. 5D+0 
BETA-0. 5D+0 

162  F-BETA**2*( 1 . D+O-ALPHA ) **2*C 1+BETA- 1 .D+0 

FA* -2 .D+O-BETA* *2 *( 1 . D+O-ALPHA ) *C 1 
FB*2 . D+0*BETA* ( 1 . D+O-ALPHA ) **2*C 1+ 1 .D+0 
G=ALPHA**2*BETA*C2+ALPHA- 1 .D+0 
GA-2  . D+O-ALPHA -BETA *C2+ 1 .D+0 
GB*ALPHA**2*C2 
DENOM=FA*GB-FB*GA 


DA« ( -F*GB+G*FB )/DENOM 
DB« ( -G*FA+F*GA )/DENOM 
ALPHA-ALPHA+DA 
BETA-BETA+DB 

IF ( ( DABS ( DA ) . GT . 1 . D-05 ) . OR . (DABS(DB ).GT.1.D-5))  GO  TO  162 
ALPH*RCON(K, 10, d)/( RCON(K , 10, d )+RCON(K , 4 , d) ) 

BET  * ( RCON( K , 10, d )+RCON( K , 4 , d ) )/( 2 . D+0*RC0N(K , 2 , d )+ 

* RCON(K, 10. d )+RCON(K , 4 , d ) ) 

I F ( 106 . EO . 1 ) GO  TO  1999 

BET0(K,d)-(BET**2/( 1 . D+O-BET ) ) * ( ( 1 . D+O-BETA )/( BETA**2 ) ) 

* »( ( 1 . D+O-ALPH) **2/ ( 1 ,D+0-ALPHA)**2) 

1999  ALPO(K, d)=BET*(ALPH**2/( 1 .D+O-ALPH) ) 

* * ( ( 1 . D+O-ALPHA )/(BETA*ALPHA* *2 ) ) 

142  CONTINUE 

C BETA-BETA(Tt) 

IF ( 106 . EO . 1 ) THEN 
DO  1122  K-3 , NXCON 
DO  1122  d* 1 , NPTS(K ) 

IF ( d . EO ■ NPTS( K ) ) THEN 
BETN(K , d )«0 . D+00 
GO  TO  1122 
ENDIF 

01 - 0. D+0 

02- 0. D+0 

03- 0. D+0 

DO  1112  III«1,LI(3) 

1112  01-01 +GIL(III,3)*DEXP(-EPSIIL(III, 3 ) /TEMPO (K , d ) ) 

DO  1113  III»1,LI(9) 

1113  Q2-Q2+GI L ( 1 1 1 , 9 ) *DEXP( -EPSI I L( 1 1 1 , 9 )/TEMPO( K , d ) ) 

DO  1130  III=1,LI(1) 

1130  03-03+GI L ( I I I , 1 )»DEXP(-EPSIIL(III , 1 )/TEMPO(K, d) ) 

RH0 1 -RCON(K , 3 , d ) * 1 . 401D+01/6 . 023D+23 
RH02-RC0N( K , 9 , d ) * 1 . 401 D+01 /6 . 023D+23 
RH03»RC0N(K , 1 , d) *2 . 802D+01/6 . 023D+23 
RH04-RH0 1+RH02+RH03 

OVIB-1 . D+0/ ( 1 . D+O-DEXP ( -3 . 39D+03/TEMP0(K , d ) ) ) 

OROT  »TEMPO(K , d )/5 . 8D+0 

C 1 -RH04-2 . 470 1 D+01 »0VIB*0R0T»03*DEXP ( 1 . 1 35D+O5/TEMP0 ( K , d ) ) 
C1-C1/(Q1**2*TEMP0(K,d)**1 .5) 

C2-RH04-8 . 909D+06-01 *DEXP( 1 . 69D+05/TEMP0(K, d) ) 

C2-C2/ (02 -TEMPO ( K , d ) »* 1 .5) 

ALPHA-0. 5D+0 
BETA-0. 5D+0 

1 132  F-BETA**2*( 1 . D+O-ALPHA )**2*C1+BETA-1 .D+0 

FA--2 . D+O-BETA » *2 * ( 1 . D+O-ALPHA ) -C 1 
FB-2 .D+O-BETA- ( 1 . D+O-ALPHA ) --2-C 1+ 1 .D+0 
G» ALPHA* *2 -BET A*C2+ ALPHA- 1 .D+0 
GA-2 . D+0* ALPHA -BET A *C2+ 1 .D+0 
GB«ALPHA**2*C2 
DENOM-FA*GB-FB*GA 
DA- ( -F  *GB+G*FB )/DENOM 
DB- ( -G*FA+F*GA )/DENOM 
ALPHA-ALPHA+DA 
BETA-BETA+DB 

IF((DABS(DA) .GT. 1 .D-05) .OR. (DABS(DB) .GT. 1 .D-5))  GO  TO  1132 
BET* ( RCON( K , 9 , d )+RCON( K , 3 , d ) )/( 2 . D+0*RC0N( K , 1 , d )+ 

* RCON(K , 9 , d )+RCON( K , 3 , d ) ) 
ALPH-RC0N(K,9,d)/(RC0N(K,9,d)+RC0N(K,3,d) ) 
BETN(K,d)-(BET*-2/( 1 . D+O-BET ))*( ( 1 . D+O-BETA )/( BETA**2 ) ) 

* *( ( 1 .D+0-ALPH)**2/( 1 . D+O-ALPHA ) **2 ) 

1122  CONTINUE 

DO  1142  K=3, NXCON 
DO  1 142  d=1 ,NPTS(K) 

I F ( d . EQ . NPTS( K ) ) THEN 
BETO(K,d) =0 . D+00 
GO  TO  1142 
ENDIF 
01=0. D+0 
02=0. D+0 
03=0. D+0 

DO  1152  111=1, LI (4) 

1152  Q1=Q1+GIL(III,4)*EXP(-EPSIIL(III,4 ) /TEMPO ( K , d ) ) 

DO  1153  I I I = 1 , LI ( 10) 

1153  Q2=Q2+GIL( III, 10) *DEXP( -EPSI IL( I I I , 10)/TEMPO(K , d ) ) 

DO  1160  1 1 1 = 1 ,LI(2) 

1 160  Q3=Q3+GIL ( III ,2)*DEXP(-EPSIIL( III ,2 ) /TEMPO ( K , d ) ) 

RHO 1 =RCON(K , 4 , d ) * 1 . 600D+0 1 /6 . 023D+23 
RH02=RC0N(K , 10,d)*1 . 600D+01 /6 . 023D+23 
RH03=RC0N(K , 2 , d ) *3 . 200D+01/ 6 . 023D+23 
RH04=RH0 1+RH02+RH03 
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QVIB*1 . D+0/( 1 . D+0-DEXP(  - 2 . 27D+O3/TEMP0(K , d) ) ) 

QROT  «T  EMPO (K, d)/4 . 2D+0 

C1«RH04*1 . 7725D+O1*QVIB*QR0T*Q3*DEXP( 5 . 950D+04/TEMPD(K, d) ) 
C1-C1/(Q1**2*TEMP0(K.d)**1 .5) 

C2*RH04*7 . 8O1D+O6*01 *DEXP( 1 . 58D+O5/TEMP0 (K , J ) ) 

C2»C2/(Q2*TEMP0(K, d)**1 .5) 

ALPHA-O. 5D+0 
BETA-O. 5D+0 

1 162  F»BETA**2*( 1 . D+O-ALPHA )**2*C 1+BETA- 1 .D+O 

FA--2.D+0*BETA**2*( 1 . D+O-ALPHA ) *C1 
FB-2.D+0*BETA*( 1 ,D+0-ALPHA)**2»C1+1 .D+O 
G»ALPHA**2*BETA*C2+ALPHA-1 .D+O 
GA«2 . D+O* ALPHA*BETA*C2+ 1 .D+O 
GB-ALPHA--2-C2 
DENOM-FA-GB-FB-GA 
DA«( -F-GB+G-FB )/DENOM 
DB-(-G*FA+F*GA)/DENOM 
ALPHA-ALPHA+DA 
BETA-BETA+DB 

IF ( (DABS (DA) . GT . 1 .D-05) . OR . ( DABS ( DB ).GT.1.D-5))  GO  TO  1162 
BET«(RCON(K, 10, J)+RCON(K. 4 , J ) )/ ( 2 . D+0*RCON(K . 2 , J ) + 

* RCON(K, 10, J)+RCON(K, 4 , J ) ) 

ALPH-RCON(K, 10. J)/( RCON(K. 10, J )+RCON(K , 4 , d ) ) 

BET0(K, J)=(BET**2/ ( 1 . D+O-BET ) ) * ( ( 1 . D+O- BETA )/ (BETA++2)) 

» *(( 1 .D+0-ALPH)**2/( 1 . D+O-ALPHA )**2) 

1142  CONTINUE 
ENDIF 
END  IF 

C ABSORPTION  COEFFICIENTS 

DO  20  K*3 , NXCON 
DO  20  J'l ,NPTS(K) 

TT=TEMP ( K . J )/ 1 68800 . 0 
I F ( 106 . EO . 1 ) THEN 

TM=TEMPO ( K , J )/ 1 68800 . 0 
ELSE 
TM'TT 
ENDIF 

IF ( ( 106 . EQ . 1 ) . AND . (TEMPO(K, 0) . LE . 8 . D+03 ) ) GO  TO  20 
IF(TEMP(K, J) .LE.8.D+03)  GO  TO  20 
IF( 108 . EO.O)  THEN 
0«BET0(K, J) 

N=BETN(K, U) 

ELSE 

0«1 .D+O 
N' 1 .D+O 
ENDIF 

KAPPA(K,4, J)«5.D-19*0*RC0N(K,2, J)+5 . D-2O*N*RC0N( K . 1 , J) 

KAP(K,4, J)«1 .7D-17*RC0N(K,3, J ) +DEXP ( - . 246/TT ) 

KA ( K , 4 , d ) “O . D+O 

KAPPA(K,3,d)»2.D-18*(N*RC0N(K, 1 , J )+0»RC0N(K , 2 , J ) )+KAPPA(K , 4 , d ) 
KAP(K,3,d)«2. ID- 17*RC0N(K, 3 ,d)*DEXP(-. 165/TT )+KAP ( K , 4 , d ) 

KA ( K , 3 , d ) *0 . D+O 

KAPPA(K,2,d)«5. ID- 18*(N*RC0N(K , 1 , d )+0*RC0N(K , 2 , d ) )+KAPPA(K , 3 , d ) 
KAP(K , 2, d) *KAP(K, 3 , d) 

KA ( K , 2 , d ) * 5 . ID- 18*RC0N(K, 4 , d ) 

KAPPA(K, 1 ,d)*2.D-17*0*RC0N(K,2,d)+4.D-16*N*RC0N(K, 1 ,d) 

C +KAPPA(K, 2 , d) 

KAP(K, 1 ,d)*1 . ID- 17»RC0N(K, 3 , d)+KAP( K , 2 , d ) 

KA(K, 1 ,d)*KA(K,2,d) 

I F ( 105 . EO .0)  THEN 
N=ALPN(K,d) 

0=ALP0(K, d) 

I F ( 108 . EO .0)  THEN 
NN«BETN(K,d) 

00«BET0(K,d) 

ELSE 

NN- 1 . D+O 
00*1 .D+O 
ENDIF 

KAPPA(K,5,d)=7. 7D- 17* (NN*RC0N(K , 1 , d )+00*RC0N( K , 2 , d ) ) 

C *DEXP(-.49/TM)+ 

C 2 . 6D- 17* (RC0N(K , 3 , d ) *N+RCON( K ,4,d)*0)*DEXP(-.723/TT) 

KAPPA(K , 6 , d)=2 . D- 18*RC0N(K, 2 , d ) *00+6 . OD- 18* ( RCON( K , 3 , d ) *N+ 

C RC0N(K,4,d)*0)*DEXP(- . 379/TT )+KAPPA( K , 5 , d ) 

I F ( RCON(K , 7 , d ) . LE . 1 . D+00)  THEN 
KAPPA(K,  7 , d) *KAPPA( K, 6 , d ) 

GO  TO  909 
ENDIF 

KAPPA ( K , 7 , d ) * 1 . 2D03* ( ( RCON(K , 3 , d ) *N+RCON( K , 4 , d ) *0 )/RCON( K , 7 , d ) ) * 

C DEXP( - . 489/TT )+KAPPA(K,6,d) 
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909  KAPPA(K,8, J ) *3 . 2D- 17* (RC0N(K , 3 , J ) *N+RC0N(K , 4 . J) *0 ) *DEXP( - . 63 1/TT ) 

C +KAPPA(K,5,d) 

ELSE 

KAPPA (K, 5. J)-7.7D-17*(RC0N(K, 1. d)+RC0N(K,2, J ) ) *DEXP( - . 49/TT  ) + 

C 2 . 6D- 17* ( RC0N(K, 3 , J )+RC0N(K , 4,J))*DEXP(-. 723/TT ) 

KAPPA(K,6,J)*2. D- 18*RC0N(K ,2,d)+6.0D-18*( RC0N( K , 3 , U)+RC0N(K , 4 , J ) ) 
C *DEXP(-.379/TT)+KAPPA(K,5. J) 

I F ( RC0N(K , 7 , vJ ) . LE . 1 . D+OO)  THEN 
KAPPA (K ,7,U)*KAPPA(K,6,J) 

GO  TO  910 
ENDIF 

KAPPA(K,7,d)*1. 2D03* ( ( RCON(K , 3 , U )+RCON( K, 4 , J ) )/RCON( K , 7 , J) ) * 

C DEXP( - . 489/TT )+KAPPA(K , 6 , J ) 

910  KAPPA(K,8, d)*3.2D-17*(RC0N(K,3.d)+RC0N(K,4,d) )*DEXP ( - . 63 1/TT ) 

C +KAPPA ( K , 5 , J ) 

ENDIF 

20  CONTINUE 

C PLANCK  FUNCTION 

DO  30  K*3 , NXCON 
DO  30  J-I.NPTS(K) 

TT«TEMP(K,d)/ 168800.0 
C IF(TEMP(K,U) .LE.8.D+03)  GO  TO  30 

BLACK* (TT* 168800 . ) **4*5 . 6696D- 1 2/3 . 1415927 
FF* 1 5. D+00/( 3. 1415927**4) 

X1-1  ./TT 

B1*FF*(DEXP(-X1 )*(6.+6.*X1+3. *X  1 **2+X 1 **3 ) + 

C DEXP( -2 . *X 1 )*0.5*( .75+1 .5*X1+1 . 5*X 1 **2+X 1 **3 ) ) 

X 1 *0 . 935/TT 

B2*FF*(DEXP(-X1 ) * ( 6 . +6 . *X 1+3 . *X 1 **2+X 1 **3 )+ 

C DEXP( -2 . *X1 ) *0 . 5* ( .75+1 .5*X 1+1 . 5*X 1 **2+X 1 **3 ) ) 

X 1 *0 . 835/TT 

B3»FF*(DEXP(-X1)*(6.+6.*X1+3 . *X 1 **2+X 1 **3 )+ 

C DEXP(-2. *X1 )»0.5*( .75+1 .5*X1+1 . 5*X 1 **2+X 1 **3 ) ) 

X1*0. 754/TT 

B4*FF*(DEXP(-X1  ) * ( 6 . +6 . *X1  + 3 . *X 1 **2+X 1 **3 ) + 

C DEXP(-2.*X1)*0.5*( .75+1 .5*X1+1 . 5*X 1 **2+X 1 **3 ) ) 

X 1 *0 . 473/TT 

B6*FF*(DEXP(-X1)*(6.+6.*X1+3.*X 1 **2+X 1**3)+ 

C DEXP(-2. *X1 )*0.5*( .75+1 .5*X1+1 . 5*X 1 **2+X 1 **3 ) ) 

X 1 *0. 2 1 3/TT 

B8*FF*(DEXP(-X1 ) * ( S . +6 . *X 1+3 . *X 1 **2+X 1 **3 ) + 

C DEXP(-2. *X1)*0.5*( .75+1 .5*X1+1 . 5*X 1 **2+X1 **3 ) ) 

B8* 1 -B8 
B2-B2-B1  . 

B3-B3-B2 
B4-B4-B3 
B6-B6-B4  ' 

B5* 1 -B8-B6-B4-B3-B2-B 1 
B ( K , 1 ,U)«BLACK*B1 
B(K,2,J)*BLACK*B2 
B(K , 3 , U ) *BLACK*B3 
B(K,4,U)*BLACK*B4 
B(K,6,U)*BLACK*BS 

B(K,7, J)=BLACK*2 . 4D-2 1 *RCON(K , 7 , U ) *B6*DEXP ( . 1G2/TT) 

B(K , 8 , U ) *BLACK*B8 
B(K,5,d)*BLACK*B5 
30  CONTINUE 

C TAU'S 

DO  100  K=3, NXCON 
DO  100  1*1,8 
I F ( I . GT . 4 ) THEN 

OPTL(K, I . 1 )*KAPPA(K, I , 1 )*DABS(Y(K, 1 ) -YBDY (K ) ) 

ELSE 

0PTL(K, I , 1 ) = ( KAPPA (K , I , 1 )+KAP(K, I . 1 )+KA ( K , I , 1 )) 

C *DABS(Y(K, l)-YBDY(K)) 

ENDIF 

DO  100  J=2 , NPTS ( K ) 

I F ( I . GT . 4 ) THEN 

K11*KAPPA(K,I, J )+KAPPA(K , I , J- 1 ) 

ELSE 

K1 1 =KAPPA(K, I , J)+KAP(K, I , U )+KAPPA (K , I , J- 1 )+KAP (K , I , d- 1 ) 

C +KA( K , I , J)+KA(K, I , J- 1 ) 

ENDIF 

OPTL(K.I ,U)=OPTL(K, I, J-1 )+(5.D-1*(K1 1 ) *DABS ( Y ( K , U- 1 ) 

C -Y ( K , J ) ) ) 

100  CONTINUE 

C ORW 

DO  200  K*3, NXCON 
WRITE( 8 , 102)  XPST(K) 

102  FORMAT (/// , ' AT  X = '.D11.4) 


o o o o o o o 


WQR-0.0 
DO  180  I « 1.8 

CALL  FEI(E1I,E2I,E3I.0PTL(K.I, 1)) 

E0LD-E2I 

JIN-1 

I F ( I . GT . 4 ) THEN 

K 1 1 -KAPPA (K,I,1)*B(K,I, 1) 

ELSE 

IF(I05.E0.1)  THEN 
ALPN(K, 1 )«1 . D+0 
ALPO ( K , 1)«1 . D+0 
ENDIF 

K1 1-KAPPA(K, I,1)*B(K,I,1 )+KAP(K, I,1)*B(K,I,1 )*ALPN(K, 1 )+ 
C KA(K,I,1)*B(K,I,1 )*ALPO(K, 1 ) 

ENDIF 

SUM-3. 14 15927 +E0LD+K1 1 *DABS( Y (K , l)-YBDY(K)) 

I F ( 109. EO.O)  WRITE ( 8 , 222 1 ) JIN.I.SUM 
DO  150  J-2 , NPTS(K) 

I F ( I . GT . 4 ) THEN 

K1 1-KAPPA(K, I,J)*B(K,I,J) 

K22«KAPPA(K,I,d-1)*B(K,I, J- 1 ) 

ELSE 

I F( 105 . EO . 1 ) THEN 
ALPN(K, J)« 1 .D+0 
ALP0(K, J ) - 1 .D+0 
ENDIF 

K1 1 -KAPPA (K , I , d ) *B(K, I , J)+KAP (K , I,J)*B(K,I,J)*ALPN(K,d)+ 
C KA(K,I,d)*B(K,I , d)*ALPO(K , d ) 

K22-KAPPA(K, I , J-1 )*B(K, I ,d-1 )+ 

C KAP(K,I, J-1)*B(K,I,d-1)*ALPN(K,d-1)+ 

C KA(K.I,d-1)*B(K,I.d-1)*ALP0(K,d-1 ) 

ENDIF 

Z-OPTL(K.I.d) 

CALL  FEI(E1I.E2I.E3I.Z) 

STSUM-3 . 14159»(K1 1 »E2I+K22*E0LD)*DABS( Y (K , J- 1 )-Y(K,d) ) 

IF ( 109 . EQ .0)  THEN 
WRITE(8 , 222 1 ) J.I.STSUM 

2221  FORMAT ( IX , ' AT  d -'.12, ' BAND  ',12,'  OR  *',D11.4) 

ENDIF 

145  SUM-SUM+STSUM 
E0LD-E2I 
150  CONTINUE 

WRITE( 8 , 103 ) I, SUM 

103  FORMAT(/, ' FOR  BAND  ',12.'  OR  - ',011.4,'  WATTS/SO . CM .' ) 
WQR-WQR+SUM 

180  CONTINUE 

WRITE(8 , 101 ) WOR 

101  FORMAT(/ ' TOTAL  OR  - '.Dll. 4,'  WATTS/SO . CM .' ) 

200  CONTINUE 
RETURN 
END 


SUBROUTINE  FEI ( E 1 1 . E2I , E3I . Z ) 

IMPLICIT  REAL*8(A-H,0-Z) 

COMMON  /RADC/  YBDY( 100) , B( 100, 8 , 40) , OPTL( 100, 8 , 40) 
CALL  EXPI(Z,E1I ,AUX) 

E2I=DEXP(-Z)-Z*E1I 
E3I«(DEXP(-Z)-Z*E2I)/2.0 
E2I=DEXP(-Z*DSQRT(3 .D+00) ) 

RETURN 

END 


SUBROUTINE  EXPI (X . RES , AUX ) 

IMPLICIT  REAL*8(A-H,0-Z) 

COMMON  /RADC/  YBDY( 100) , B( 100, 8 , 40) , OPTL( 100 , 8 , 40) 

IF (X- 1 . ) 2,1,1 

1 YY-1./X 

AUX* 1 .-YY»((( YY+3. 377358 ) *YY+2 . 052 1 56 ) *YY+2 . 709479D-01 )/(((( YY* 

Cl . 072553+5 . 7 16943 )»YY+G . 945239 ) -YY+2 . 593888 ) *YY+2 . 70949GD-01 ) 
RES=AUX*YY*DEXP( -X ) 

RETURN 

2 I F (X+3  . ) 6,6,3 

3 AUX- ( (((((( 7 . 122452D-7*X-1 . 766345D-6 ) *X+2 . 928433D-5 ) *X-2 . 335379D-4 
C)*X+1 . 664 156D-3 )*X- 1 .041 576D-2 ) *X+5.555682D-2)*X-2. 50000 ID- 1 )»X 
C+9 . 999999D- 1 

RES— 1.D+30  r->* 


o o o 


IF(X)  4.5,4 

4 RES=X*AUX-DL0G(ABS(X))-5.772157D-1 

5 RETURN 

6 I F (X+9 . ) 8,8,7 

7 AUX=1 .-( ( ( (5. 1 76245D-2*X+3. 06 1037 )*X+3. 2436550+ 1 ) *X+2 . 244234D+2 ) *X 

^ C+2 . 486697D+2 ) / ( ( ( (X+3.995161 ) *X+3 . 893944D+ 1 ) *X+2 . 263818D+ 1 )*X 

C+1 .807837D+2) 

GO  TO  9 

8 YY-9./X 

AUX-1 ,-YY*(((YY+7.659824D-1 ) *YY-7 . 27101 5D- 1 ) *YY- 1 . 080693 )/( ( ( ( YY 
0*2.518750+1 . 122927D+1 ) *YY+5 . 92 1405 ) *YY-8 . 666702 ) *YY-9 . 7242 16 ) 

9 RES“AUX*DEXP(-X)/X 
RETURN 

END 


) 


i 


f 


SUBROUTINE  CARRAD  (104,105,109) 

IMPLICIT  REAL*8(A-H,0-Z) 

COMMON  /A  1/  TE1.TE2.M, IX, IMAX.IPSI, MODEL 

COMMON  /A3/  EVI INF( 25 ) , THETA I (25).MUI(25),FI(25),DELHI(25), 

* CIINF(25),LI(25) 

COMMON  /A5/  EPSIIL(20,25),GIL(20,25) , CID( 200, 50) 

COMMON  / A9/  EVISC25) ,XPST( 100) 

COMMON  /RAD/  RCON( 100, 10 , 40) . RRHO( 100, 40) , TEMP( 100, 40) 

* ,TSTAG,Y( 100,40) ,NXCON,NPTS( 100) 

COMMON  /RADC/  YBDY ( 100) , B ( lOO, 8 , 40) , OPTL( 100 , 8 , 40) 

COMMON  /RADO/  TEMPO( 100, 40) . ALPN( 100, 40) , ALPO( 100, 40) 

REAL*8  KAPPA( 100,8,40) ,MUI 
WRITE ( 8 , 1 ) 

1 FORMAT(///'  CARLSON  RADIATION  MODEL') 

C NUMBER  DENSITIES 

IF( (104. EO. 5) .OR. (104 . E0.6) ) GO  TO  1111 
DO  12  K = 3 , NXCON 
DO  12  d = 1 , NPTS ( K ) 

DO  10  11*1, I MAX 

10  RCON(K, II , d)=RRH0(K,d)*6.O23D+23*RC0N(K. II ,d)/MUI(II  ) 

12  CONTINUE 

C NONE OUI LIBRIUM  RADIATION  CORRECTION 

IF  (IQ5.EO.O)  THEN 
DO  122  K*3, NXCON 
DO  122  d=1 ,NPTS(K) 

I F (d . EQ . NPTS(K) ) THEN 
ALPN(K , J ) *0 . D+00 
GO  TO  122 
END  IF 
01=0.0+0 
02=0. D+0 
03=0. D+0 

DO  112  1 1 1 = 1 ,LI(3) 

112  Q1=Q1+GIL(III,3)*DEXP(-EPSIIL(III,3)/TEMP(K,J)) 

DO  113  1 1 1 * 1 , LI (9  ) 

113  Q2=Q2+GIL(III . 9 )*DEXP ( -EPSI I L( 1 1 1 ,9)/TEMP(K. d) ) 

DO  130  I I I = 1 ,LI( 1 ) 

130  03=03+GI L( III, 1)*DEXP(-EPSIIL(III, 1 )/TEMP(K, d) ) 

RH0 1 =RCON(K , 3 , d ) * 1 . 401 D+0 1 /6 . 023D+23 
RH02  = RC0N( K , 9 , d ) * 1 . 401D+01 / 6 . 023D+23 
RHO3*RC0N(K , 1 , d)*2 . 802D+01/6 . 023D+23 
RH04=RHO 1+RH02+RH03 

OVIB= 1 . D+0/ ( 1 . D+0_DEXP( -3 . 39D+03/TEMP ( K , d ) ) ) 
0R0T=TEMP(K,d)/5. 8D+0 

C1=RH04*2. 4 701 D+0 1 *0VIB*0R0T*03*DEXP( 1 . 1 35D+05/TEMP ( K , d ) ) 
C1=Cl/(Q1**2*TEMP(K,d)**1 .5) 

C2=RH04*8 . 909D+06*Q1 *DEXP ( 1 . 69D+05/TEMP(K , d ) ) 
C2=C2/(Q2*TEMP(K,d)**1 .5) 

ALPHA=0 . 5D+0 
BETA=0 . 5D+0 

132  F=BETA**2* ( 1 . D+0- ALPHA )**2*C1+B ETA-1 .D+0 
FA=-2.D+0*BETA»*2*( 1 . D+0- ALPHA ) *C 1 
FB=2 .D+0*BETA*( 1 . D+O-ALPHA ) **2*C1+ 1 .D+0 
G = ALPHA*  *2*BETA*C2+ALPHA- 1 .D+0 
GA=2 . D+0*ALPHA*BETA*C2+ 1 .D+0 
GB “ALPHA “*2*C2 
DENOM=FA*GB-FB*GA 
DA=(-F*GB+G*FB)/DENOM 
DB= ( -G*FA+F*GA )/DENOM 
ALPHA=ALPHA+DA 
BETA=BETA+DB 

IF((DABS(DA)  . GT . 1 .D-05) .OR. (DABS(DB).GT. 1 . D-5 ) ) GO  TO  132 
ALPH=RCON(K , 9 , d )/( RCON(K , 9 , d )+RCON( K , 3 , d ) ) 


o o o 


BET* ( RCON(K , 9 , d )+RCON(K , 3 , J ) )/( RCON(K, 9 , d)+RCON(K , 3 , <J) 

* +2.D+0*RC0N(K, 1,d)) 

ALPN(K,d)-(ALPH**2/( 1 . D+O-ALPH) ) * ( ( 1 . D+0-ALPHA)/( ALPHA**2 ) ) 

* *(BET/BETA) 

122  CONTINUE 

ENDIF 

1111  CONTINUE 

C PLANCK  FUNCTION 

DO  13  K*3 , NXCON 
DO  13  J* 1 , NPTS( K ) 

TTT*TEMP(K, J) 

CALL  PLANCK(B(K, 1 , d) , B(K , 2 , d ) , B( K , 3 . d ) . B(K . 4 , d ) , B(K , 5 , d ) , TTT) 
13  I F ( 105 . EO . 0)  B(K, 1 ,d)*ALPN(K,d)*B(K, 1 ,d) 

C ABSORPTION  COEFFICIENTS 

DO  20  K«3, NXCON 
DO  20  d* 1 , NPTS( K) 

DO  20  1*1,5 

KAPPA(K , I , d ) *ABSORB(K , d , I ) 

IF( ( 105 . EO .0) .AND . ( I .NE . 1 ) ) KAPPA(K , I , d ) *KAPPA(K , I . d) 

* *ALPN(K , d ) 

20  CONTINUE 

C TAU'S 

DO  100  K*3, NXCON 
DO  100  1*1,5 

OPTL(K, I , 1 )-KAPPA (K , I , 1 )*DABS(Y(K, 1 )-YBDY(K) ) 

DO  100  d*2 , NPTS(K) 

OPTL(K, I ,d)*OPTL(K, I ,d-1 ) + (0 . 5* ( KAPPA(K , I , d)+KAPPA(K , I ,d-1 ) )* 
C DABS(Y(K,d-1)-Y(K,d))) 

100  CONTINUE 

C ORW 

DO  200  K*3, NXCON 
WRITE(B, 102)  XPST(K) 

102  FORMAT(//, ' AT  X * ' .D11.4) 

W0R«0 . 0 

DO  180  1*1,5 

CALL  FEI(E1I , E2I , E3I ,OPTL(K, 1 . 1) ) 

E0LD-E2I 
dIN*  1 

SUM*3. 141 5927*B(K , I , 1 )*EOLD*KAPPA(K, I , 1 )*DABS(Y(K, 1 ) -YBDY (K ) ) 
I F ( 109 . EO . 0)  WRITE ( 8 , 222 1 ) dIN.I.SUM 
DO  150  d*2,NPTS(K) 

Z*OPTL(K, I ,d) 

I F ( Z . EO . 0 . D+0)  THEN 
E2I * 1 .D+0 
GO  TO  145 
ENDIF 

CALL  FEI(E1I,E2I,E3I,Z) 

STSUM-3. 14159*(B(K, I ,d)*KAPPA(K, I ,d)*E2I+B(K, I ,d-1 )* 

C KAPPA (K, I ,d-1 )*E0LD)*DABS(Y(K,d-1 )-Y(K,d) ) 

IF ( 109 . EO.O)  THEN 
WRITE ( 6 , 222 1 ) d.I.STSUM 

2221  FORMAT (IX,'  AT  d *',I2,'  BAND  ',12,'  OR  *',D11.4) 

ENDIF 

145  SUM*SUM+STSUM 
E0LD-E2I 
150  CONTINUE 

WRITE ( 8 , 103 ) I, SUM 

103  FORMAT ( / ' FOR  BAND  ',12,'  OR  * \D11.4,'  WATTS/SO . CM .' ) 

WQR*WQR+SUM 

180  CONTINUE 

WRITE ( 8 , 101 ) WQR 

101  FORMAT ( / ' TOTAL  OR*', Dll. 4,'  WATTS/SO . CM .' ) 

200  CONTINUE 

RETURN 

END 


SUBROUTINE  PLANCK(B 1 , B2 , B3 , B4 , B5 , YY ) 

IMPLICIT  REAL*8(A-H,0-Z) 

COMMON  /RAD/  RCON( 100 , 10, 40) , RRHO( 100 . 40) , TEMP ( 100, 40) 
* , TST  AG , Y ( 100,40) .NXCON, NPTS( 100) 

COMMON  /RADC/  YBDY ( 100) , B( 100, 8 , 40) . OPTL( 100 , 8 , 40) 

T = YY 

IF(T. LE. 20000. 0)GOTO 1027 
1027  IF(T.GE .8000.0) GOT0 1029 
B 1 =0 . 0 
B2  = 0 . 0 
B3  = 0 . 0 
B4=0 . 0 


B5-0.0 

RETURN 

1029  IF(T.LE. 10000. 0)GOT01030 
IF(T . LE . 12000. O)G0TO1O31 
IF(T.LE. 14000. 0)G0T01032 
IF(T.LE. 16000.0) GOTO 1033 
IF(T . LE . 18000.0) GOT0 1034 
GOT0 1240 

1030  B1“10.0**(-65. 26966+15 . 87 146*DL0G10(T ) ) 

B2* 10 . 0**( -54 . 1 198 1+13. 22561 *DL0G1O(T)) 

B3- 10.0** (-44. 83075+1 1 .0539 1 *DL0G10(T ) ) 

B4» 10.0** (-16. 5251 1+4. 425444*DL0G10(T) ) 

B5*10.0* *(-8.8741 56+2. 2 16357*DL0G1O(T ) ) 

B 1 “B 1 *1000.00 

B2“B2* 1000.00 
B3*B3* 1000.00 
B4«B4* 1000.00 
B5*B5* 1000 . 00 
RETURN 

1031  B1«( 10.0**( -54.67501+13. 22279*DL0G10(T) ))* 1000.0 
B2«( 10.0** (-44 .60436+ 10. 84674*DL0G10(T) ))* 1000.0 
B3-(  10.0**( -36. 91518+9.075018*DL0G10(T)))* 1000.0 
B4«(  10.0** (-15. 3003 1+4. 1 19244*DL0G1O( T ) ) )* 1000 .0 
B5*( 10.0* *(-7.83 1680+1 . 955738*DL0G 10( T ) ) ) * 1000 . 0 
RETURN 

1032  B1»( 10.0** (-47. 32488+1 1 . 42O93*DL0G10(T ) ))* 1000.0 
B2*( 10.0** (-37. 87564+9. 1972 17*DL0G10(T )))* 1000 .0 
B3*( 10.0** (-31 .30212+7 .69899 1*DL0G10(T) ))* 1000.0 
B4«( 10.0** (-14 . 17392+3.8431 13*DL0G1O(T) ) )* 1000.0 
B5« ( 10.0** (-7. 128949+1 . 783465*DL0G 10(T ) ) ) * 1000 .0 
RETURN 

1033  B1  = ( 10.0** (-41 .90448+10. 1 1359*DL0G10(T ) ) )* 1000.0 
B2»( 1 0.0* *(-32 .87166+7 .9903 16*DL0G10(T) ))* 1000.0 
B3*( 10.0** (-27. 12177+6. 690739*DL0G10( T ) ) ) * 1000 . 0 
B4* ( 10 . 0** ( - 13 . 1 2000+3. 58892 1 *DLOG 1 0(T )))* 1000.0 
B5«( 10. O'* (-6. 625956+1 . 662 149*DL0G10(T ) ) ) * 1000 .0 
RETURN 

1034  B1*( 10.0** (-37. 77432+9. 1 3 1 18 1 *DL0G10(T ) ) ) * 1000 .0 
B2«(  10.0**  ( -28. 96032+7. 059955*DL0G10(T ) ) )* 1000.0 
B3*( 10.0** (-23. 90936+5. 926629*DL0G10( T ) ) )* 1000.0 
B4»( 10.0** (-12. 13764+3. 355253 *DLOG 10(T ) ) ) * 1000.0 
B5«( 10.0** (-6. 259400+1 . 574959*DL0G10(T ) ) ) * 1000 .0 
RETURN 

1240  B1»( 10.0* *(-34 ,49941+8.36166*DL0G1O(T) ) )* 1000.0 
B2«( 10.0**( -25. 87330+6. 33544 *DLOG 10( T ) ) )* 1000.0 
B3*( 10.0** (-21 . 34066+5. 32298*DL0G1O(T )))* 1000.0 
B4* ( 10 . 0** ( - 1 1 . 28150+3 . 154O*DL0G1O(T) ) )* 1000.0 
B5-( 10.0** (-5. 97387+1 . 50786*DL0G10(T ) ) )* 1000. 0 
RETURN 
END 
C 



C 

FUNCTION  ABSORB(K, I , ISTEP) 

IMPLICIT  REAL*8(A-H,0-Z) 

COMMON  /RAD/  RCON( 100, 10 . 40) , RRHO ( 100, 40) , TEMP ( 100, 40) 
* ,TSTAG,Y( 100,40) ,NXCON.NPTS( 100) 

COMMON  /RADC/  YBDY ( 100) , B ( 100, 8 , 40) , 0PTL( 100, 8 , 40) 

C THIS  PROGRAM  USES  5 WAVELENGTH  STEPS 

C THE  NEXT  CARD  MUST  BE  CHANGED  FOR  GRAY  GAS  CASE 

IGRAY  =0 . 0 
T«TEMP(K,I) 

BLACKB=( ( 5 . 6697D-05 )*(T**4))/3. 14159 
YYY'T 

YY=T/ 10000.0 

IF (YYY.LE. 20000. O)G0T0 1035 

1036  FORMAT ( 1 HO, 5X , ' T TEST  FAILED  IN  ABSORB') 

CONTINUE 

1035  IF( IGRAY . EO. 1 )G0  TO  1037 

GO  TO  ( 1037, 1038, 1039, 1040. 1041 ), ISTEP 

1037  I F ( YYY . LT . 8000 . 0)G0  TO  1042 
I F( YYY.LE. 10000. O)G0T0 1043 

I F ( YYY . LE . 12000.0) GOT0 1044 
IF (YYY.LE . 14000. 0)GOTO 1045 
I F ( YYY . LE . 16000. 0)GOT01046 
I F ( YYY . LE . 18000. 0)GOT01047 
GOTO  1241 

1042  ABS0RB=O . 0 
GO  TO  1048 

1043  ABSORB" ( 1 ,0061D-13)*( 10 . 0**( -2 . 6064* YY ) ) 


GO  TO  1049 

1044  ABS0RB-(9.6882D-15)*( 10.0**(-1 .5953*YY)) 

GO  TO  1049 

1045  ABSORB* ( 2 . 0340D- 1 5 ) *( 10.0**(-1 .0304*YY)) 

GO  TO  1049 

1046  ABSORB* ( 6 . 9685D- 16 ) * ( 10 . 0** ( -0 . 698 1 * YY ) ) 

GO  TO  1049 

1047  ABSORB* ( 3.31 88D- 16 ) * ( 10 . 0* * ( -0 . 49675* YY ) ) 

GOT0 1049 

1241  ABSORB- ( 2 . 0976D- 16 ) * ( 10 . 0** ( -0 . 38605* YY ) ) 

1049  FNDEN-RCON(K , 3,1) 

EDEKT* (4 . 7070-06 ) * ( RCON(K , 7,I)**(2.0/7.0))/(((0.86 1 760-04 )*YYY ) 
11.5) 

EDEKT*DEXP( EDEKT) 

ABSORB- (ABSORB*EDEKT)*FNDEN 

1048  ABS0R1 -ABSORB 

I F( IGRAY . EO . 1 )GOTO 1038 
RETURN 

1038  I F ( YYY . LT . 8000 . 0) GOT0 1050 
I F ( YYY . LE . lOOOO . 0)GOTO 105 1 
I F ( YYY . LE . 12000. 0)GOT01052 
I F ( YYY . LE . 14000.0) GOT0 1053 
I F ( YYY . LE . 16000.0) GOTO  1054 
IF(YYY.LE. 18000 . 0)GOTO 1055 
GOT0 1 242 

1050  ABSORB-O.O 
GOT0 1056 

1051  ABS0RB=(5.9872D-22)*( 10 . O** ( 2 . 01935*YY ) ) 

GOT0 1057 

1052  ABSORB- ( 3. 2660D-21 )*( 10.0**( 1 .28255*YY) ) 

GOT0 1057 

1053  ABSORB- ( 1 . 1243D-20) * ( 10 . 0** (0 . 835 1 5*YY ) ) 

GOT0 1057 

1054  ABSORB- ( 2 . 1 562D-20) * ( 10 . 0** (0 . 633 15*YY ) ) 

GOT0 1057 

1055  ABSORB- ( 3 . 701 2D- 20) * ( 10 . 0** (0 . 4865*YY ) ) 

GOT0 1057 

1242  ABSORB- ( 5. 4757D-20)*( 10.0** (0.3924*YY)) 

1057  FNDEN-RCON(K , 3,1) 

EDEKT- ( 4 . 707D-06 ) * ( RCON(K . 7 . I ) ** ( 2 . 0/7 . 0 ))/((( 0 . 86 1 76D-04 ) *YYY ) 
11.5) 

EDEKT-DEXP( EDEKT) 

ABSORB- ( ABSORB*EDEKT ) *FNDEN 

1056  ABS0R2 -ABSORB 

I F ( IGRAY . EO . 1 )GOTO 1039 
RETURN 

1039  I F ( YYY . LT . 8000 . 0)GOTO 1058 

I F ( YYY . LE . 10000.0) GOT0 1059 
IF(YYY.LE. 1 2000 . 0) GOT0 1060 
I F ( YYY . LE . 14000. 0)GOT01061 
I F ( YYY . LE . 16000.0) GOT0 1062 
I F ( Y Y Y . LE . 18000.0) GOTO  1063 
GOT0 1 243 

1058  ABSORB-O.O 
GOT0 1064 

1059  ABSORB- (( 7. 266D-20)*( 10.0**(21 ,267*YY)))*( 1 .00-20) 

GOTO  1065 

1060  ABS0RB-(2.2772D-19)*( 10 . 0** (0 . 77045* YY ) ) 

GOT0 1065 

1061  ABSORB=(4.8471D-19)*(10.0**(0. 49705*YY ) ) 

GOT0 1065 

1062  ABSORB- (8 . 1764D-19)*( 10 . 0** (0 . 33485*YY ) ) 

GOT0 1065 

1063  ABSORB- ( 1 . 1902D-18)*( 10.0**(0. 23295*YY) ) 

GOTO  1065 

1243  ABSORB- ( 2 . 19875D- 1 8 ) * ( 10 . 0** (0 . 08485* YY ) ) 

1065  FNDEN=RCON(K, 3,1) 

ABSORB- ABSORB*FNDEN 

1064  ABS0R3- ABSORB 
I F ( IGRAY . EO . 1 )GOT01040 
RETURN 

1040  IF(YYY.LT. 8000 . 0) GOT0 1066 
I F (YYY . LE . 10000.0) GOT0 1067 
I F ( YYY . LE . 12000.0) GOTO  1068 
I F ( YYY . LE . 14000.0) GOT0 1069 
I F ( YYY . LE . 16000.0) GOT0 1070 
I F ( YYY . LE . 18000. 0)GOT01071 
GOTO  1244 

1066  ABSORB-O.O 
GOTO  1072 


1067  ABSORB- ( 3. 4065D-30)*( 10.0**(7 . 2773*YY) ) 

GOT0 1073 

1068  ABSORB- ( 8 . 31880-28 ) * ( 10 . 0** (4 . 8895*YY ) ) 

GOTO 1073 

1069  ABSORB- ( 2 . 8643D-26 )* ( 10 .0**( 3 . 6087-YY) ) 

GOT0 1073 

1070  ABSORB- ( 1 . 9928D-25 )*(10.0**(3. 00695* YY ) ) 

GOT0 1073 

1071  ABS0RB«(3.9376D-24)*( 10.0** (2 . 197 1 *YY ) ) 

G0T01073 

1244  ABSORB- (4. 2515D-24)*( 10.0**(2. 1786-YY)) 

1073  FNDEN-RC0N(K,3, I ) 

EDEKT-(4 . 707D-06 )*(RCDN(K , 7 , 1 )**(2 .0/7 .0) )/( ( (0.861760-04 ) *YYY ) 
11.5) 

EDEKT -DEXP ( EDEKT ) 

ABSORB- (ABSORB* EDEKT )*FNDEN 

1072  ABS0R4-ABS0RB 

I F ( IGRAY . EO . 1 ) GOT0 104 1 
RETURN 

1041  1 F ( YYY . LT . 8000 . 0)G0T0 1074 
IF ( YYY . LE . 10000.0) GOT0 1075 
I F ( YYY . LE . 12000.0) GOT0 1076 
I F ( YYY . LE . 14000.0) GOT0 1077 
I F ( YYY . LE . 16000.0) GOT0 1078 
I F ( YYY . LE . 18000.0) GOT0 1079 
GOT0 1245 

1074  ABSORB-O.O 
GOTO 1080 

1075  ABSORB- ( 3 . 1595D-27 ) * ( 10 .0** (6 . 54335*YY ) ) 

GOT0 1081 

1076  ABS0RB=(6.8837D-25)*( 10 . 0** (4 . 205 1 5*YY ) ) 

GOT0 1081 

1077  ABSORB- ( 1 .80790-23) *( 1 0 . O** ( 3 . 02235* YY ) ) 

GOTO  1081 

1078  ABSORB* ( 4 . 1675D-22 ) * ( 10 . 0** ( 2 . 04900*YY ) ) 

GOT0 1081 

1079  ABSORB- ( 2 . 4630D-2 1 )*( 10.0**( 1 ,56667*YY) ) 

GOT0 1081 

1245  ABSORB- ( 1 . 0535D-20) * ( 10 . O** ( 1 . 2161*YY) ) 

1081  FNDEN-RCON(K , 3,1) 

AB SORB -AB SORB *FNDEN 

1080  ABS0R5- ABSORB 
IF(IGRAY.EO. DG0T01O82 
RETURN 

1082  ABS0RB-(ABS0R1*B(K, 1 , I )+ABS0R2*B(K ,2,1 )+ABS0R3*B ( K , 3 , I )+ 

1 ABS0R4*B(K , 4 , I )+ABS0R5*B ( K , 5 . I ) )/BLACKB 

ABSORB- ABSORB* ( 1 .00+07) 

RETURN 

END 

C 

C 

c 

SUBROUTINE  CORRAD  (104.105,106,108,109) 

IMPLICIT  REAL*8(A-H,0-Z) 

COMMON  /A  1 / TE1 ,TE2,M, IX, IMAX, IPSI .MODEL 

COMMON  / A3/  EVIINF(25) , THETA I ( 25 ) , MU I (25) , FI (25) .DELHI (25) , 

* CIINF(25) , LI ( 25 ) 

COMMON  / A5/  EPSI I L ( 20, 25 ) , GI L( 20, 25 ) , CID( 200, 50) 

COMMON  / A9/  EVIS(25),XPST( 100) 

COMMON  /RAD/  RCON( 100, 10, 40) , RRHO( 100, 40) . TEMP ( 100 . 40) 

* , TSTAG , Y ( 100,40) ,NXCON,NPTS( 100) 

COMMON  /RADC/  YBDY( 100) , B ( 100, 8 , 40) . OPTL ( 100, 8 , 40) 

COMMON  /RADO/  TEMP0( 100, 40) , ALPN( 100, 40) , ALPO( 100, 40) 

COMMON  /RADOL/  BETN( 100 . 40) , BETO( 100, 40) 

DIMENSION  CR(40, 13) 

REAL*8  KAPPA( 100,8,40) ,MUI 
WRITE ( 8 , 1 ) 

1 FORMAT ( /// ' CORNELL  RADIATION  MODEL') 

I F ( 108 . EO . 0)  THEN 

I F ( 106 . EO . 0)  WRITE (8,2) 

I F ( 106 . EO. 1 ) WRITE (8 , 3 ) 

END  IF 

2 FORMAT ( / ' BETA-BETA(Te)  ' ) 

3 FORMAT(/ ' BETA-BETA (Tt  ) ' ) 

C NUMBER  DENSITIES 

C AND  NONEOUI LIBRIUM  CORRECTION 

IF((IQ4.EQ.5).0R.  (IQ4.EQ.6))  GD  T0  mi 

DO  10  K-3.NXC0N 
DO  10  J=1 , NPTS ( K ) 

DO  10  11=1 , IMAX 


** 


XXX«RRHO( K , J ) *6 . 023D+23 
XXX=XXX*RCON(K , 1 1 , d )/MUI  (II) 

10  RC0N(K, II , d)-XXX 
IF  (I05.E0.O)  THEN 
DO  122  K-3 , NXCON 
DO  122  d«1,NPTS(K) 

IF( J . EO . NPTS( K ) ) THEN 
ALPN( K , d )“0 . D+00 
BETN( K , d ) -0 . D+00 
GO  TO  122 
END  IF 
Q1 ”0.0+0 

02- 0. D+0 

03- 0. D+0 

DO  112  III”1,LI(3) 

1 12  Q1”Q1+GIL(III ,3) *DEXP( -EPSIIL( III, 3 )/TEMP(K , <J ) ) 

DO  113  111=1, LI(9) 

113  Q2»Q2+GIL( III ,9  )*DEXP( -EPSI IL( III , 9)/TEMP(K,  J) ) 

DO  130  111=1, LI(1) 

1 30  03-03+GI L( I I I , 1 ) *DEXP ( -EPSI I L ( I I I , 1 )/TEMP(K , J ) ) 

RH0 1 “RCON( K , 3 , J ) * 1 . 401D+01 /6 . 023D+23 
RH02=RC0N ( K , 9 , J ) * 1 . 401 D+01 /G . 023D+23 
RH03=RC0N(K , 1 , J ) *2 . 802D+01/6 . 023D+23 
RH04 -RHO 1 +RH02+RH03 

OVIB-1 ,D+0/( 1 .D+0-DEXP(-3.39D+03/TEMP(K,d) )) 

OROT =TEMP(K,d)/5. 8D+0 

C 1 =RH04*2 . 4701D+01  *QVIB*QR0T»Q3*DEXP( i . 1 35D+05/TEMP(K , d) ) 
C 1 =C 1/ (Q 1 **2*TEMP(K , d ) ** 1 .5) 

C2-RH04-8 . 909D+06*Q 1 *DEXP( 1 . 69D+05/TEMP( K , d ) ) 
C2=C2/(02*TEMP(K,d)**1 .5) 

ALPHA-0. 5D+0 
BETA-0. 5D+0 

132  F=BETA**2*(1. D+0- ALPHA )**2*C1+B ETA-1. D+0 

FA--2 . D+0*BETA**2* ( 1 . D+0- ALPHA ) *C  1 
FB-2 . D+O+BETA* ( 1 . D+O-ALPHA ) »*2»C 1+ 1 . D+0 
G=ALPHA**2*BETA*C2+ALPHA- 1 .D+0 
GA-2 . D+0*ALPHA*BETA*C2+ 1 .D+0 
GB-ALPHA*»2»C2 
DENOM-FA*GB-FB*GA 
DA- ( -F»GB+G*FB )/DENOM 
DB-( -G-FA+F-GA )/DENOM 
ALPHA-ALPHA+DA 
BETA-BETA+DB 

IF(  (DABS (DA ) . GT . 1 . D-05 ) . OR . ( DABS( DB ).GT.1.D-5))  GO  TO  132 
ALPH-RCON ( K , 9 , d ) / ( RCON ( K , 9 , d ) +RCON( K , 3 , d ) ) 

BET- ( RCON(K , 9 , d )+RCON( K , 3 , d ) )/ ( 2 . D+0* RCON ( K , 1 ,d)+ 

* RCON ( K , 9 , d ) +RCON ( K , 3 , d ) ) 

IF( 106 . EQ . 1 ) GO  TO  1888 

BETN(K,d)=(BET**2/( 1 . D+O-BET ) ) * ( ( 1 . D+O-BETA )/ (BETA* *2)) 

* *( ( 1 .D+0-ALPH)**2/( 1 . D+O-ALPHA ) **2 ) 

1888  ALPN( K , d ) -BET* ( ALPH--2/ ( 1 .D+O-ALPH) ) 

* •(  ( 1 . D+O-ALPHA )/ ( BETA -ALPHA* *2 ) ) 

122  CONTINUE 

DO  142  K-3, NXCON 
DO  142  d«1 , NPTS(K) 

IF (d . EO . NPTS ( K ) ) THEN 
ALPO(K, d)-0.D+00 
BETO( K, d )=0 . D+00 
GO  TO  142 
ENDIF 
01=0. D+0 
02-0. D+0 
Q3-0.D+0 

DO  152  III-1,LI(4) 

152  01=Q1+GIL(III,4)*EXP(-EPSIIL(III, 4 )/TEMP(  K , d ) ) 

DO  153  111=1, LI (10) 

153  02=02+GIL(III, 10) *DEXP( -EPSI I L ( 1 1 1 , 10)/TEMP(  K , d ) ) 

DO  160  III=1,LI(2) 

160  Q3=Q3+GIL(III , 2 ) *DEXP ( -EPSI I L( I I I , 2 )/TEMP(K , d ) ) 

RH0 1 -RCON ( K , 4 , d ) * 1 . 600D+01 /6 . 023D+23 
RH02=RC0N(K , 10,d)»1 . 600D+01 /6 . 023D+23 
RH03=RC0N(K , 2 , d) *3 . 200D+01/6 . 023D+23 
RH04-RH01+RH02+RH03 

OVIB= 1 . D+0/ ( 1 . D+0-DEXP( -2 . 27D+03/TEMP( K , d ) ) ) 

OROT-TEMP ( K , d )/4 . 2D+0 

C 1 -RH04* 1 . 7725D+01 *0VIB*QR0T*Q3*DEXP( 5 . 950D+04/TEMP (K, d ) ) 
C1=C1/(01«»2*TEMP(K,d)**1 .5) 

C2=RH04*7 . 801D+06-01 *DEXP ( 1 . 58D+05/TEMP (K , d) ) 

C2-C2/ ( 02*TEMP( K , d ) ** 1 . 5 ) 

ALPHA-0. 5D+0 

fHS 


BETA-0. 5D+0 

162  F*BETA**2*( 1 . D+O-ALPHA ) **2*C 1+BETA- 1 .D+O 

FA*-2.D+0*BETA**2*(  1 . D+O- ALPHA ) *C 1 
FB*2 .D+0*BETA*( 1 . D+O-ALPHA ) **2*C 1+ 1 .D+O 
G-ALPHA**2*BETA*C2+ALPHA-1 .D+O 
GA*2.D+0*ALPHA*BETA*C2+1 .D+O 
GB* ALPHA* *2*02 
DENOM=FA*GB-FB‘GA 
DA* ( -F*GB+G*FB ) /DENOM 
DB*( -G*FA+F*GA )/DEN0M 
ALPHA*ALPHA+DA 
BETA*BETA+DB 

IF( (DABS (DA)  .GT. 1 .D-05) .OR. (DABS(DB) .GT. 1 .D-5) ) GO  TO  162 
ALPH*RCON( K , 10, d )/ ( RCON( K . 10 , d )+RCON(K , 4 , d)  ) 

BET* ( RCON ( K , 1 0 . J )+RCON (K,4.d))/(2. D+0*RC0N ( K , 2 . 0 )+ 

* RCON(K, 10,d)+RCON(K,4,d) ) 

IF ( 1 06 . EO . 1)  GO  TO  1999 

BET0(K,J)  = (BET**2/( 1 .D+O-BET ) ) * ( ( 1 . D+O-BETA )/ (BETA**2 ) ) 

* *( ( 1 . D+0-ALPH)**2/( 1 . D+O-ALPHA ) **2 ) 

1999  ALP0(K,d)-BET*(ALPH**2/( 1 .D+O-ALPH) ) 

* *(( 1 . D+O-ALPHA )/ (BETA* ALPHA* *2 ) ) 

142  CONTINUE 

C BETA*BETA(Tt) 

I F( 106 . EO . 1 ) THEN 
DO  1122  K=3 , NXCON 
DO  1122  d«1 . NPTS ( K ) 

IF( J . EO . NPTS( K ) ) THEN 
BETN(K.d) *0.0+00 
GO  TO  1122 
END  IF 
01*0. D+O 
02=0. D+O 
03*0.0+0 

DO  1112  111*1 ,LI(3) 

1112  01*01+GIL( III, 3)*DEXP(-EPSIIL( III , 3)/TEMP0(K, J)  ) 

DO  1113  1 1 1* 1 , LI (9 ) 

1113  02*02+GIL(III ,9)*DEXP(-EPSIIL(III , 9 )/T£MPO( K , d ) ) 

DO  1130  III*1,LI(1) 

1130  03*03+GIL ( III, 1)*DEXP(-EPSIIL(III, 1 )/TEMPO(K, d) ) 

RH01 *RCON( K , 3 , d ) * 1 . 401 D+0 1/6 . 023D+23 
RH02=RCON(K , 9 , d ) * 1 . 401D+01 /6 . 023D+23 
RH03*RC0N(K, 1 , d ) *2 . 802D+01/6 . 023D+23 
RH04“RH0 1+RH02+RH03 

OVIB* 1 . D+O/ ( 1 . D+O-DEXP ( -3 . 39D+03/TEMP0  ( K , d ) ) ) 

QROT  *T£MPO( K , d ) /5 . 8D+0 

Cl =RH04*2 . 4701D+01 *0VIB*QR0T*Q3*DEXP( 1 . 1 35D+O5/TEMP0( K , d ) ) 
C1*C1/(Q1 * *2 ‘TEMPO (K , d ) ** 1 .5) 

C2=RH04*B . 909D+06*01 *DEXP( 1 . 69D+05/TEMP0( K , d ) ) 
C2=C2/(Q2*TEMP0(K,d)**1 .5) 

ALPHA*0 . 5D+0 
BETA-0. 5D+0 

1132  F«BETA**2*( 1 . D+O-ALPHA )* *2*C 1+BETA- 1 .D+O 

FA*-2 . D+0*BETA*  *2* ( 1 . D+O-ALPHA ) *C 1 
FB*2 . D+0*BETA* ( 1 . D+O-ALPHA ) **2*C1+1 . D+O 
G=ALPHA**2*BETA*C2+ALPHA- 1 .D+O 
GA=2 . D+O* ALPHA *B ETA *C2+ 1 .D+O 
GB-ALPHA**2*C2 
DENOM=FA*GB-FB*GA 
DA= ( -F*GB+G*FB ) /DENOM 
DB=(-G*FA+F*GA) /DENOM 
ALPHA-ALPHA+DA 
BETA-BETA+DB 

IF((DAB5(DA) . GT . 1 .D-05) .OR. (DABS(DB) .GT. 1 .D-5) ) GO  TO  1132 
BET* ( RCON( K , 9 , d )+RCON(K , 3 , d ) )/( 2 . D+0*RCON(K , 1 , d )+ 

* RCON(K , 9 , d ) + RCON( K , 3 , d ) ) 

ALPH=RCON(K  , 9 , d ) / ( RCON(  K , 9 , d )+RCON(K , 3 , d ) ) 
BETN(K,d)=(BET**2/( 1 .D+O-BET) )*(( 1 . D+O-BETA )/(BETA**2 ) ) 

* *( ( 1 . D+O-ALPH) **2/ ( 1 . D+O-ALPHA ) **2 ) 

1122  CONTINUE 

DO  1142  K=3, NXCON 
DO  1 142  d=1 ,NPTS(K) 

IF(d.EO.NPTS(K))  THEN 
BET0(K,d)=0. D+00 
GO  TO  1142 
END  IF 
01=0.0+0 
02*0. D+O 
03=0.0+0 

DO  1152  III=1,LI(4) 

01=01+GIL(III,4)*EXP(-EPSIIL(III,4 ) /TEMPO  (K , d ) ) 


1 152 


DO  1153  III  * 1 , LI ( 10) 

1153  Q2-Q2+GIL( III, 10) *DEXP( -EPSI I L( I I I . 10)/TEMP0(K , d ) ) 

DO  1160  111*1, LI (2) 

1160  Q3«Q3+GIL(III , 2 ) *DEXP( -EPSI I L( I I I ,2)/TEMP0(K, d)) 

RH0 1 -RCON( K , 4 , d ) * 1 . 600D+0 1/6 . 023D+23 
RH02«RC0N(K, 10, J ) * 1 . 600D+01/6 . 023D+23 
RH03«RCON(K,2, J ) *3 . 200D+01/6 . 023D+23 
RH04-RH01+RH02+RH03 

QVIB-1 . D+0/ ( 1 .D+O-DEXP(-2.27D+O3/TEMP0(K.d) ) ) 
QR0T«TEMP0(K,d)/4.2D+O 

C 1 -RH04* 1 . 7725D+01 *QVIB*QR0T*Q3*DEXP( 5 . 950D+04/TEMP0(K , J ) ) 
C1-C1/(Q1**2*TEMP0(K,d)**1 .5) 

C2*RH04*7 . 8010+06*01 *DEXP ( 1 . 58D+O5/TEMP0(K , J ) ) 
C2-C2/(Q2*TEMP0(K,d)**1 .5) 

ALPHA-0. 50+0 
BETA-0. 5D+0 

1 162  F«BETA**2»( 1 . D+0- ALPHA )**2*C1+B ETA-1 .D+0 

FA--2 . D+0*BETA**2* ( 1 . D+O-ALPHA ) »C 1 
FB-2 . D+O+BETA* ( 1 . D+O-ALPHA ) **2*C 1+ 1 .D+0 
G=ALPHA*»2*BETA*C2+ALPHA- 1 .D+0 
GA-2 . D+0*ALPHA*BETA*C2+ 1 .D+0 
GB»ALPHA**2*C2 
DENOM-FA*GB-FB*GA 
DA- ( -F*GB+G*FB )/DENOM 
DB- ( -G*FA+F*GA )/DENOM 
ALPHA-ALPHA+DA 
BETA-BETA+DB 

IF(  (DABS(DA) .GT. 1 .D-05) .OR. (DABS(DB) . GT . 1 .D-5) ) GOTO  1162 
BET - ( RCON(K , 10, J )+RCON( K , 4 , J ) )/( 2 . D+0*RC0N( K , 2 , J )+ 

* RCON(K, 10, J ) + RCON( K , 4 , J ) ) 

ALPH=RCON(K , 10, J )/( RCON(K , 10, d )+RCON(K , 4 , d ) ) 
BET0(K,d)=(BET*»2/( 1 . D+O-BET ) ) * ( ( 1 . D+O-BETA )/(BETA**2 ) ) 

» «( ( 1 ,D+0-ALPH)**2/( 1 . D+O-ALPHA ) **2 ) 

1142  CONTINUE 
ENDIF 
END  IF 

1111  CONTINUE 


ORW 

DO  200  K-3.NXC0N 
WRITE ( 8 , 102 ) XPST(K) 

102  FORMAT (///,'  AT  X - '.D11.4) 

WOR-O.O 

DO  120  d= 1 , NPTS ( K ) 

TT -TEMP(K, J) 

CR ( d , 1 )-3.6D-13*RC0N(K,2, 1 ) *DEXP ( -5 . 7D+4/TT ) 

CR ( d , 2 ) = 1 . 8D- 14»RC0N(K, 1 , 1 ) *DEXP ( -8 . 3D+4/TT ) 

CR(d,3)=3. OD- 1 3*RC0N( K , 5 , 1 ) *DEXP ( -6 . 7D+4/TT ) 

CR( d , 4 ) -2 . ID- 19*RC0N(K , 5 , 1 ) *DEXP ( -7 . 6D+3/TT ) 

SM=2 . 0D-20* ( RCON( K , 3 , 1 )+RC0N(K,7, 1 ) ) -DEXP ( -5 . 2D+04/TT ) 

CR ( d , 5 ) -SM* 1 . OD- 14 

SM=3 . 0D-20* ( RCON(K , 4 , 1 )+RC0N(K,7, 1 ) ) -DEXP ( -4 . 2D+04/TT ) 
CR(d,6)-SM*1 . OD - 1 4 
IF( IQ5 . EQ.O)  THEN 

CR ( d , 7 ) = 1 . D- 10*RC0N(K , 3,d)*DEXP(-1 . 8D+05/TT )*ALPN(K,d) 
CR(d,8)-8.D-1 3*RC0N( K ,3,d)*DEXP(-5. 9D+04/TT )*ALPN(K,d) 
CR(d,9)=9.D-11 *RCON( K ,4,d)*DEXP(-1 . 7D+05/TT ) *ALP0( K , d) 

CR ( d , 10) =8 ,D-13*RC0N(K,4, d)*DEXP(-5 . 9D+04/TT ) *ALPO(K , d) 

I F ( 108 . EO . 0 ) THEN 

CR(d, 13)«1 .6D-12*RC0N(K,8,d)*DEXP(-3. 6D+04/TT )*BETN(K,d) 
ELSE 

CR(d, 13)»1 . 6D- 1 2*RC0N(K ,8,d)*DEXP(-3. 6D+04/TT ) 

ENDIF 

ELSE 

CR ( d , 7 ) = 1 . D- 10*RC0N( K,3,d)*DEXP(-1 .8D+05/TT) 
CR(d,8)=8.D-13*RC0N(K,3,d)*DEXP(-5. 9D+04/TT ) 

CR ( d , 9 ) =9 . D- 1 1 *RCON( K ,4,d)*DEXP(-1 .7D+05/TT) 

CR ( d , 10) =8 . D- 1 3*RC0N(K ,4,d)*DEXP(-5. 9D+04/TT  ) 

CR ( d , 1 3 ) = 1 . 6D- 1 2*RC0N(K ,8,d)*DEXP(-3. 6D+04/TT ) 

ENDIF 

CR ( d , 1 1 )=9.D-33*(RC0N(K,9,d)+RC0N(K,7,d)) 

**DEXP ( - 1 . 4D+04/TT ) 

CR ( d , 12)=9.D-33*(RC0N(K, 10, d)+RCON(K,  7 , d) ) 

**DEXP( - 1 . 4D+04/TT ) 

120  CONTINUE 

DO  180  1 = 1 , 13 
dIN-1 

RSUM=3 . 141 5927D+00+CR ( 1 , I )*DABS( Y(K, 1 ) -YBDY ( K ) ) 
IF(I09.E0.O)  WRITE ( 8 , 222 1 ) dIN.I.RSUM 
DO  150  d=2 , NPTS ( K ) 

STSUM=0 . 5D+00* ( CR ( d , I )+CR(d-1 , I ) ) *DABS( Y ( K , d- 1 )-Y(K, d) ) 


o o o 


C *2. D+00*3. 1415927 

I F( 109 . EO.O)  THEN 
WRITE(8 , 222 1 ) d.I.STSUM 

2221  FORMAT ( IX , ' AT  J ='.12.'  EOUATION  ',12. ' OR  »',D11.4) 

END  IF 

RSUM-RSUM+STSUM 
150  CONTINUE 

WRITE (8 , 103 ) I.RSUM 

103  FORMAT(/ , ' FOR  EOUATION  ',12,'  OR  * '.Dll. 4,'  WATTS/SO . CM .' ) 

WOR-WQR+RSUM 
180  CONTINUE 

WRITE ( 8 , 101 ) WOR 

101  FORMAT(/ ' TOTAL  OR  « '.Dll. 4,'  WATTS/SO . CM. ' ) 

200  CONTINUE 
RETURN 
END 


SUBROUTINE  ANDRAD  (104,105,109) 

IMPLICIT  REAL»8(A-H,0-Z) 

COMMON  /A  1/  TE1.TE2.M, IX. IMAX.IPSI, MODEL 

COMMON  /A3/  EVIINF(25) , THETA I (25),MUI(25),FI(25),DELHI(25), 

* CIINF(25) , LI (25) 

COMMON  /A5/  EPSI I L ( 20, 25 ) , GI L ( 20, 25 ) , CID( 200, 50) 

COMMON  /A9/  EVIS( 25) , XPST ( 100) 

COMMON  /RAD/  RCON( 100, 10. 40) , RRHO( 100. 40) . TEMP( 100, 40) 

* ,TSTAG,Y( 100.40) ,NXCON.NPTS( 100) 

COMMON  /RADC/  YBDY( 100) , B ( 100 . 8 . 40) . OPTL( 100, 8 . 40) 

COMMON  /RADO/  TEMPO ( 100 . 40 ) , ALPN( 100 , 40) . ALPO ( 100 , 40) 

REAL*8  KAPPA ( 100 , 8 . 40) , MU I 
WRITE ( 8 , 1 ) 

1 FORMAT ( / // ' ANDERSON  RADIATION  MODEL') 

C NUMBER  DENSITIES 

IF((IQ4.EQ.5) .OR. (IQ4.EQ.6))  GO  TO  1111 
DO  10  K=3.NXC0N 
DO  10  d«1 .NPTS(K) 

DO  10  11  = 1, 1 MAX 
XXX=RRHO(K , J ) *6 .023D+23 
XXX=XXX*RCON(K , I I , J)/MUI (II) 

10  RCON(K,II ,d)«XXX 

C NONEOU I LIBRIUM  RADIATION  CORRECTION 

IF  (105. EO.O)  THEN 
DO  122  K-3.NXC0N 
DO  122  d=1,NPTS(K) 

IF(d.EQ.NPTS(K))  THEN 
ALPN( K , U) =0 . D+00 
GO  TO  122 
END  IF 
01=0. D+0 
02=0. D+0 
03=0. D+0 

DO  112  111=1, LI(3) 

112  01=01+GIL(III,3)*DEXP(-EPSIIL(III, 3 )/TEMP(K,  d) ) 

DO  113  III=1,LI(9) 

113  Q2=Q2+GIL(III .9)*DEXP(-EPSIIL(III,9)/TEMP(K,d) ) 

DO  130  III=1,LI(1) 

130  03=Q3+GIL(III . 1 ) »DEXP( -EPSI IL( I I I . 1 )/TEMP(K, d) ) 

RH0 1 «RCON( K , 3 , d ) * 1 . 40 1 D+0 1 /S . 023D+23 
RH02=RCON(K , 9 , d ) “ 1 . 401D+01/6 . 023D+23 
RH03=RC0N(K , 1 , d ) »2 . 802D+01/6 . 023D+23 
RH04=RH0 1+RH02+RH03 

OVIB  = 1 . D+0/( 1 . D+O-DEXP ( -3 . 39D+03/TEMP(K,  d) ) ) 
QR0T=TEMP(K,d)/5. 8D+0 

C 1 =RH04*2 . 4701 D+0 1 *OVIB*OROT*03*DEXP( 1 . 135D+05/TEMP(K, d) ) 
C1=C1/(01**2*TEMP(K.d)**1 .5) 

C2=RH04*8.909D+06»Q1*DEXP( 1 .69D+05/TEMP(K, d) ) 

C2=C2/ ( 02*TEMP(K , d ) ** 1 .5) 

ALPHA=0 . 5D+0 
BETA=0. 5D+0 

132  F=BETA»*2*( 1 . D+0- ALPHA )*»2*C1+B ETA-1 .D+0 

FA=-2.D+0*BETA*»2»( 1 . D+0- ALPHA ) »C 1 
FB=2 . D+0*BETA* ( 1 . D+O-ALPHA ) *=2*C 1+ 1 .D+0 
G=ALPHA**2*BETA*C2+ALPHA-1 .D+0 
GA  = 2 . D+0* ALPHA * BETA  *C2+ 1 .D+0 
GB=ALPHA»*2*C2 
DENOM=FA*GB-FB*GA 
DA=(-F*GB+G*FB)/DENOM 
DB=(-G*FA+F*GA)/DENOM 
ALPHA=ALPHA+DA 

s-ii 


BETA-BETA+DB 

IF( (DABS (DA ) .GT . 1 . D-05 ) .OR . (DABS (OB ).GT.1.D-5))  GO  TO  132 
ALPH-RCON(K , 9 , d)/( RCON(K , 9 , d )+RCON(K, 3 , d) ) 

BET“(RCON(K , 9 , d )+RCON(K , 3 , J ) )/( RCON(K , 9 , d)+RCON(K,  3 , J ) 

* +2 . D+0*RC0N(K , 1 , J) ) 

ALPN(K,d)-( ALPH**2/( 1 . D+O-ALPH) ) * ( ( 1 . D+O-ALPHA )/( ALPHA--2 ) ) 

* * (BET/BETA) 

122  CONTINUE 

END  IF 

1111  CONTINUE 

C DENSITY  RATIOS 

DO  12  K-3 , NXCON 
DO  12  d-I.NPTS(K) 

IF( IQ4 . EQ . 4 ) RC0N(K,7,d)»RC0N(K,7, J)*RRHO(K, d)  »6 . 023D+23/MUI ( 7 ) 
RRHO(K , d)*RRHO(K , J )/ 1 . 2250D-03 
12  CONTINUE 

C PLANCK  FUNCTION 

DO  30  K-3, NXCON 
DO  30  d"1,NPTS(K) 

TT-TEMP(K.d)/ 168800.0 
C IF(TEMP(K,d) .LE.8.D+03)  GO  TO  30 

BLACK- (TT* 168800. ) »»4*5 . 6696D- 1 2/3 . 14 15927 
FF- 1 5. D+00/( 3. 1415927**4) 

XI -1 . /TT 

B1»FF»(DEXP(-X1 )*(6.+6.*X1+3. -X 1 »*2+X 1 »»3 )+ 

C DEXP(-2.*X1 ) »0.5* ( .75+1 .5*X 1+1 . 5»X 1 *»2+X 1 »*3 ) ) 

X 1 -0 . 935/TT 

B2-FF*(DEXP(-X1 ) » (6 . +6 . *X1+3 . *X1*»2+X1»»3)+ 

C DEXP(-2. *X1 )»0.5»( .75+1 ,5*X 1+1 . 5*X 1 **2+X 1 »*3 ) ) 

X 1 =0 . 835/TT 

B3-FF*(DEXP(-X1 ) * (6 . +6 . *X 1+3 . *X 1 **2+X 1 **3 )+ 

C DEXP(-2.*X1 )*0.5*( .75+1 ,5*X1+1 . 5-X1 »»2+X 1 »*3 ) ) 

X 1 -0 . 754/TT 

B4«FF*(DEXP(-X1)*(6.+6.*X1+3.*X1**2+X1»*3)+ 

C DEXP(-2. *X1 )*0.5*( . 75+1 . 5+X1+1 . 5*X 1 **2+X1 **3 ) ) 

X 1 *0 . 473/TT 

B6«FF*(DEXP(-X1 ) * ( 6 . +6 . »X 1+3 . »X 1 *»2+X 1 »»3 )+ 

C DEXP(-2. *X1 ) *0.5+ ( .75+1 .5*X 1+1 . 5*X1 »*2+X 1 **3 ) ) 

X 1 =0*.  2 1 3/TT 

B8-FF*(DEXP( -XI ) *(6 . +6 . *X1+3 . *X 1 **2+X 1**3)+ 

C DEXP(-2.*X1)*0.5*( .75+1 .5-X1+1 . 5*X 1 **2+X 1 **3 ) ) 

B8-1-B8 
B2-B2-B 1 
B3-B3-B2 
B4-B4-B3 
B6-B6-B4 

B5- 1-B8-B6-B4-B3-B2-B 1 
B(K, 1 ,U)-BLACK*B1 
B(K , 2 , U ) -BLACK »B2 
B( K , 3 . U ) -BLACK *B3 
B ( K , 4 , J ) -BLACK *B4 
IF( 105 . EO.O)  THEN 
B(K, 1 ,d)«B(K, 1 ,d)*ALPN(K,d) 

B(K,2,d)»B(K.2,U)*ALPN(K,d) 

B(K,3, J)-B(K,3,d)»ALPN(K,U) 

B(K,4.d)-B(K,4. J)-ALPN(K.U) 

ENDIF 

B ( K , 6 , d )-BLACK*B6 

B (K , 7 , d ) -BLACK *2 . 4D-2 1 *RCON(K ,7,d)*B6*DEXP( . 162/TT) 

B(K , 8 , d) -BLACK-B8 
B(K, 5, d)-BLACK*B5 

B(K, 1,d)-B(K, 1 ,d)+B(K.2.d)+B(K,3,d)+B(K,4.d) 

B(K,2,d)*B(Kf5, d )+B(K , 6 , d)+B(K , 7 , d )+B(K , 8 , d ) 

30  CONTINUE 

C ABSORPTION  COEFFICIENTS 

DO  20  K-3, NXCON 
DO  20  d»1 ,NPTS(K) 

TT-TEMP ( K , d ) / 1 . 0D+04 
IF(TEMP(K,d) .LE. 1 . 1D+04)  THEN 
KAPPA ( K , 1 , d ) -36 . D+00*RRH0(K , d ) *TT»*4 . 02 
ELSE 

KAPPA ( K , 1 ,d)*RRH0(K,d)*(8. 1D+00+4 1 . 3D+00+TT ) 

ENDIF 

IF(TEMP(K,d) .LE.7.D+03)  THEN 
AA-234 . 7D+00 
BB- 1 . 4 1D+00 
CC-7 . 83D+00 
GO  TO  25 
ENDIF 

IF(TEMP(K,d) .LE.9.D+03)  THEN 


AA*262.D+00 
BB* 1 . 4D+00 
CC«8. 19D+00 
GO  TO  25 
ENDIF 

IF (TEMP(K, J) . LE . 1 . 1D+04)  THEN 
AA*266 . D+OO 
BB* 1 . 15D+00 
CC* 1 3 . 86D+00 
GO  TO  25 
ENDIF 

IF (TEMP(K, J) . LE . 1 . 3D+04)  THEN 
AA*232 . D+OO 
BB* 1 . 06D+00 
CC* 1 3 . ID+OO 
GO  TO  25 
ENDIF 

AA*406 . 5D+00 
BB* 1 . ID+OO 
CC«1 1 . 3D+00 

25  JP*AA*RRHO(K, J) **BB*TT**CC 
IF(B(K,2, J).LE. 1 .D-05)  THEN 
KAPPA ( K , 2 , J ) *0 . D+00 
GO  TO  20 
ENDIF 

KAPPA (K , 2 , J ) * JP/B(K , 2 , J ) 

I F ( 105 . EO . 0)  THEN 

KAPPA(K , 2 , J ) *KAPPA(K#  2 , J) *ALPN(K , J ) 

ENDIF 

20  CONTINUE 

C TAU ' S 

DO  100  K*3 , NXCON 
DO  100  1*1,2 

OPTL(K, X, 1 )*5 . D-01*KAPPA(K, I , 1 )*DABS( Y(K, 1 )-YBDY(K) ) 

DO  100  J*2 , NPT$(K) 

OPTL ( K , I . J)*OPTL(K, I PJ-1 )+(0. 5*(KAPPA(K, I . d)+KAPPA(Kf I , J-1 ))* 
C DABS( Y(K, J-I)-Y(K.J))) 

100  CONTINUE 

C QRW 

DO  200  K*3, NXCON 
WRITE ( 8 , 102 ) XPST(K) 

102  FORMAT ( /// , * AT  X * '.D11.4) 

WOR=0.0 

DO  180  1*1.2 

CALL  FEKE1I.E2I,  E3I  , OPTL(K,  I , 1)) 

E0LD*E2I 
JIN*  1 

SUM*3. 1415927*E0LD*B(K, I . 1 )*KAPPA(K, I , 1 )*DABS(Y(K, 1 ) -YBDY(K ) ) 
I F ( 109 . EO .0)  WRITE ( 8 , 222 1 ) JIN, I, SUM 
DO  150  J*2 , NPTS( K ) 

2*0PTL(K, I . J) 

I F ( Z . EO . 0 . D+0)  THEN 
E2I * 1 . D+0 
GO  TO  145 
ENDIF 

CALL  FEX(E1I, E2I.E3I.Z) 

STSUM=3 . 141 59* ( B (K , I , J)*KAPPA(K, I . J ) *E2I+B ( K , I , J- 1 ) * 

C KAPPA(K, I.J-1 ) *EOLD ) *DABS( Y (K,J-1)-Y(K,J)) 

I F ( 109 . EQ . 0)  THEN 
WR ITE ( 8 , 222 1 ) J.I.STSUM 

2221  FORMAT (IX,'  AT  J =',12,'  BAND  ',12,'  OR  *',D11.4) 

ENDIF 

145  SUM=SUM+STSUM 
E0LD=E2I 
150  CONTINUE 

WRITE (8,1 03 ) I, SUM 

103  FORMAT ( / , ' FOR  BAND  ',12.'  OR  = '.D11.4,'  WATTS/SO . CM . ' ) 
WQR*WQR+SUM 

180  CONTINUE 

WRITE ( 8 , 101 ) WOR 

101  FORMAT ( / ' TOTAL  OR  = '.D11.4,'  WATTS/SQ.CM.') 

200  CONTINUE 

XF((I04.EQ.5).0R. (IQ4.EQ.6))  THEN 
DO  1000  K=3, NXCON 
DO  1000  J*1 , NPTS ( K ) 

RRHO ( K , J ) =RRHO ( K , J ) * 1 . 225D-03 
1000  CONTINUE 
ENDIF 
RETURN 
END 


LISTING  OF  INPUT  FILE  SCREEN 


LINE  #1 


* —INPUT  NAMELIST 


IPF  - OUTPUT  PRINT  FREOUENCY 

M - VIBRATIONAL  EQUILIBRIUM  (Y'O.N'1) 

NSR  - NO.  OF  STRLNES  IN  THE  STAGNATION  REGION 
IANS  - FULL  FLOW  FIELD  SOLN.  (Y-O.N-1) 

MW  - MILLIKAN  & WHITE  DATA  (Y'I.N'2) 

MODEL  - VIBEQ-O,  CVD'1,  CVDV-2,  CVDV-PREF'3,  PARK'4 
I Q3  - FROZEN  FLOW« 1 , N2-FR0ZEN.02-DISS*2.  N2&02-DISS-3 

101  - (TVIB'TINF )*1 , (TVIB'TTRANS)»2  (FOR  DISS.  SHOCK  JUMP) 

102  - ( TEL'TINF )« 1 , (TEL'TTRANS)'2  (FOR  DISS.  SHOCK  JUMP) 

104  - NO  RAD . MODELS'O,  OLSTAD'1.  CARLSON'2,  CORNELL'S.  ANDERSON-4 

ALL  MODELS'5,  ALL  MODELS  WITH  CAPTURED  VALUES'6 

105  - NON-EOUIL  CORR.  FOR  ATOMIC  RADIATION  (Y-O.N'I) 

107  - STRLNE  #.  FOR  DETAILS  (NO  STRLNE  DETAIL-0) 

106  - (BETA'BETA(TE) )«0, (BETA«BETA(T ) )'1 

108  - NON-EOUIL  CORR.  FOR  MOLECULAR  RADIATION  (Y'O.N'1) 

109  - VALUES  AT  EACH  STEP  (Y«0,N«1) 

LINE  *2 

IS1.IS2.IS3.IS4.IS5.IS6  - SIX  STRLNES  SELECTED  FOR  PARTIAL  FLOW  SOLN. 

1)  IS1<IS2<  (NSR+1)  .LE.  IS3<IS4<IS5<IS6 

LINE  #3 

XI  - INTEGRATION  STEP  SIZE  (CM) 

DELX  - DELTA-X  INCREMENT  ALONG  SHOCK  (CM) 

ZSTERM  - LENGTH  OF  SYMMETRY  AXIS  Z (CM) 

VINF  - FREESTREAM  VELOCITY  (CM/SEC) 

PINF  - FREESTREAM  PRESSURE  (DYNES/CM--2) 

TINF  - FREESTREAM  TEMPERATURE  (K) 

LINE  #4 

IS7  - SELECTED  STRLNE  #.  OUTPUT  ON  T.TVN2,  ALL  Cl'S  WITH  COORD. 

PTS  X.Z.R.L,  AND  BODY, SHOCK,  AND  STRLNE  GEOMETRIES  (PLOTS) 

1)  IS7  > NSR 


» LINE 

* 1 : IPF, M, NSR. IANS, MW, MODEL, 103, 101, 102. 104, 105, 107, 106, 108. 109, 1010 

* 2 : IS1 , IS2, IS3, IS4, IS5, IS6 

» 3 : XI .DELX, ZSTERM. VINF, PINF, TINF 

* 4 : IS7 


50,1.3.0,1.4.1,2,2.6,1,0,0,0,1.0 
236  13  18  20 

1 ! 220703 125E-04, 0.50, 0.200, 8.91 5E+05, 15.715,197.101 
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PROGRAM  AFE2 

an  inverse  hypersonic  flow  solution  for  an  afe/aotv  body  in 

CHEMICAL  NONEQUILIBRIUM  USING  VIBRATION- DISSOCIATION  COUPLING  MODELS, 
SHOCK  JUMP  APPROXIMATIONS,  ELECTRON  TEMPERATURE  MODELING,  AND 
UNCOUPLED  RADIANT  HEAT  TRANSFER  USING  A METHOD  DERIVED  BY  S.MASLEN 

BASED  ON  AN  ORIGINAL  PROGRAM  BY  B.L.  WEIGEL  FOR  WILLIAM  L.  GROSE 
VIRGINIA  POLYTECHNIC  INSTITUTE  - 1969,  (NASA  TN  D-6529,  DEC.  1971) 

PROGRAM  MODIFICATION  BY: 

TEXAS  A&M  UNIVERSITY 
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TAMRF-5671  (1987-1988) 


PRINCIPAL  INVESTAGATOR 
RESEARCH  ASSISTANT 
RESEARCH  ASSISTANT 


DR.  LELAND  A.  CARLSON 
GLENN  J.  BOBSKILL 
ROBERT  B.  GREENDYKE 


CALINTH  : INTEGRATION  ROUTINE  BY  CHARLES  E.  TREANOR 
THE  NUMERICAL  INTEGRATION  ALGORITHM  USED  IS  FOUND  IN  A METHOD 
FOR  THE  NUMERICAL  INTEGRATION  OF  COUPLED  FIRST  ORDER 
DIFFERENTIAL  EQUATIONS  WITH  GREATLY  DIFFERENT  TIME  CONSTANTS 


FOFE 

FOFTS1 

FOFTS23 

FTLUP 


- EVALUATE  E BY  NEWTON  ITERATION  METHOD 

- EVALUATE  TS  BY  NEWTON  ITERATION  METHOD,  CHEMISTRY  FROZEN 

- FOFTS1  WITH  N2  FROZEN,  02  DISSOCIATING  OR  BOTH  N2  & 02  DISS. 

- INTERPOLATION  ROUTINE 


DATA  FILES 


c 

UNIT 

7 

IS 

USED 

FOR  THE  INPUT  DATA  FILE 

c 

UNIT 

8 

IS 

USED 

FOR  THE  OUTPUT  DATA  FILE 

c 

UNIT 

9 

IS 

USED 

TO 

STORE 

VIBRATIONAL  ENERGY  DATA  AT  THE  SHOCK  (FORMATTED) 

c 

UNIT 

10 

IS 

USED 

TO 

STORE 

ALL  STAGNATION  QUANTITIES 

c 

UNIT 

11 

IS 

USED 

TO 

STORE 

all  evis  data  for  computational  purposes 

c 

UNIT 

12 

IS 

USED 

TO 

STORE 

ALL  PRESSURE  DATA 

c 

UNIT 

13 

IS 

USED 

TO 

STORE 

ALL  DPDX  DATA 

c 

UNIT 

14 

IS 

USED 

TO 

STORE 

QUANTITIES  FOR  PHYSICAL  SPACE  CALCULATIONS 

c 

UNIT 

15 

IS 

USED 

TO 

STORE 

QUANTITIES  FOR  RAD. FOR 

c 

UNIT 

16 

IS 

USED 

TO 

STORE 

QUANTITIES  FOR  RAD. FOR 

c 

r> 

UNIT 

17 

IS 

USED 

TO 

STORE 

QUANTITIES  FOR  RAD. FOR 

0 

c 

INPUT-NAMELIST 

DELX  - INCREMENT  ALONG  SHOCK  , cm 

ZSTERM  « LENGTH  OF  SYMMETRY  AXIS  , Z , cm 

IMAX  - MAX.  NO.  OF  I-S  SPECIES  , LESS  THAN  OR  EQUAL  TO  25 

JMAX  “ MAX.  NO.  OF  J-S  REACTIONS  , LESS  THAN  OR  EQUAL  TO  50 

MJ  - CODE  INDICATING  WHICH  SPECIES  , I , TO  USE  TO  CALCULATE 

COUPLING  FACTOR,  PHI  SUB  J , FOR  REACTION  J 
M =1  FOR  VIBRATIONAL  NON- EQUILIBRIUM 

- 0 FOR  VIBRATIONAL  EQUILIBRIUM 
R - UNIVERSAL  GAS  CONSTANT  , erg/(mole-K) 

GAMMA  * RATIO  OF  SPECIFIC  HEATS 

CIINF  - FREESTREAM  MASS  FRACTION  FOR  EACH  SPECIES 


5*  * 


H 


o o o o o o 


PINF  - FREESTREAM  PRESSURE  , dynes/cm**2 
TINF  - FREESTREAM  TEMPERATURE  , K 
VINF  - FREESTREAM  VELOCITY  , cm/sec 
MUI  - MOLECULAR  WT.  FOR  EACH  SPECIES  , gm/mole 
THETAI  - CHARACTERISE  VIBRATIONAL  TEMPERATURE  , K 
DGENI  - FUDGE  FACTOR  TO  PERMIT  APPROXIMATING  POLYATOMIC  MOLECULE 
C BY  A DIATOMIC  MOLECULE 

C FI  - 0 FOR  MONATOMIC  SPECIES 

C - 1 FOR  ALL  OTHERS 

C DELHI  - HEAT  OF  FORMATION  , ergs/mole 

C DELI  - DISSOCIATION  ENERGY  OF  SPECIES  , K 

C EVI  - VIBRATIONAL  ENERGY  OF  SPECIES  , ergs/g 

C BI  - 3/2*ln(2*PI*Mi*k/h**2)  + ln(k)  + FI(I)*ln(THETAI(Rotational)) 

C + ln(GIL(I , 1) ) FOR  EACH  SPECIE  I 

C LI  NUMBER  OF  ELECTRONIC  LEVELS  FOR  EACH  SPECIES  ( LI.LE.20  ) 

C GIL  - DEGENERACY  OF  L-TH  ELECTRONIC  LEVEL  FOR  I-TH  SPECIES 

C EPSIIL  - L-TH  ELECTRONIC  ENERGY  LEVEL  FOR  I-TH  SPECIES  , K 

C AJ  - FREQUENCY  FACTOR  IN  ARRENIUS  TYPE  RATE  EQN. 

C BJ  TEMPERATURE  EXPONENT  IN  ARRENIUS  TYPE  EQN. 

C EJ  ACTIVATION  ENERGY  IN  ARRENIUS  TYPE  EQN. 

C DIRECT  - DIRECTION  OF  THE  REACTION  ( FORW.  - 1.0  , BACK.  - 2.0  ) 

C AIJ  - FACTOR  TO  ALLOW  USE  OF  GENERAL  SPECIES  IN  REACTION  EQNS . 

C i.e.  (N2  + M - 2N  + M) , AIJ  - 1.0  OR  (N2  + 02  - 2N0) , AIJ  - 0.0 

C NUIJ  - STOICHIOMETRIC  COEFFICIENTS  OF  I-TH  REACTANT  IN  J-TH  REACTION 

C NUPIJ  - STOICHIOMETRIC  COEFFICIENTS  FOR  I-TH  PRODUCT  IN  J-TH  REACTION 

C ALP  IK  - FACTORS  IN  EQN.  FOR  VIBRATIONAL  RELAXATION  TIME 

C BETAIK  - FACTORS  IN  EQN.  FOR  VIBRATIONAL  RELAXATION  TIME 

C SIGIK  - FACTORS  IN  EQN.  FOR  VIBRATIONAL  RELAXATION  TIME 

C NIP  - NUMBER  OF  VIBRATIONAL  LEVELS  FOR  ANHARMONIC  OSCILLATOR  , K 

C UP  CHARACTERISTIC  PROBABILITY  TEMPERATURE  , K 

C WE  CONST.  USED  TO  COMPUTE  ANHARMONIC  OSCILLATOR  , K 

C WEXE  - CONST.  USED  TO  COMPUTE  ANHARMONIC  OSCILLATOR  , K 

C WEYE  - CONST.  USED  TO  COMPUTE  ANHARMONIC  OSCILLATOR  , K 

C WEZE  - CONST.  USED  TO  COMPUTE  ANHARMONIC  OSCILLATOR  , K 

C XI  - INITIAL  COMPUTING  INTERVAL  , .0001220703125  UNLESS  INPUT  , cm 

C ELE1  - (2*IMAX  + 1)  VALUES  USED  BY  INTEGRATION  SCHEME 

C NORMALLY  0.1 ,0.5,  OR  .05  , (UPPER  PH  RANGE) 

C ELE2  - (2*IMAX  + 1)  VALUES  USED  BY  INTEGRATION  SCHEME 

C NORMALLY  .05,.!,  OR  .01  AND  .LT.  ELE1  , (LOWER  PH  RANGE) 

C XPST  - 99  OR  LESS  Xs  AT  WHICH  PHYSICAL  SPACE  CALCULATIONS  ARE 

C DESIRED.  THEY  MUST  BE  MULTIPLES  OF  DELX  IN  ORDER  TO  HAVE 

C RS , COST , ZS , AND  SINT  VALUES  AND  LAST  MUST  BE  .GT.  X AT 

C ZSTERM.  THEREFORE,  XPST(NXPST)  SET  - X AT  ZSTERM  + 100.0 

C IN  PROGRAM.  XPST(l)  MAY  NOT  BE  0.0  . THEREFORE,  SET 

C XPST(l)  - DELX  IN  PROGRAM 

C NXPST  - NUMBER  OF  Xs  AT  WHICH  PHYSICAL  SPACE  CALCULATIONS  ARE 

C DESIRED 

C CIMAX  - MAX.  CJ  OR  COMPUTING  INTERVAL  0.0625  UNLESS  INPUT  OTHERWISE 

C HCHCKT  - CONTROL  ON  SIZE  OF  COMPUTING  INTERVAL  IN  CHECK 

C IF(ABS (HPREV  - H) /H . GT . HCHECK)  REDUCE  INTERVAL 

C TCHCKT  - CONTROL  ON  SIZE  OF  COMPUTING  INTERVAL  IN  CHECK 
C IF(ABS (TPREV  - T) /T . GT . TCHECK)  REDUCE  INTERVAL 

C PHMAX  - CONTROL  ON  COMPUTING  INTERVAL  .LE.  65.0 

C IPF  - OUTPUT  PRINT  FREQUENCY 

C 

C STOPS 

C 

C STOP  1 INCORRECT  INPUT 

C STOP  2 IN  MAIN  WHEN  NXPST  IS  .LE.  2 

C STOP  13  IN  SHOCKG 


ss* 


noooooooooo 


STOP  30  IN  CHECK  WHEN  COMPUTING  INTERVAL  .LT.  1.0E-15 
STOP  66  IN  BASIC  WHEN  NO  CONVERGENCE  ON  E ITERATION  (FOFE) 

STOP  301  IN  MAIN  FOR  ERROR  IN  XPST  ARRAY  OR  IZTERM  .GT.  200 

STOP  321  IN  MAIN  WHEN  NO  CONVERGENCE  ON  TS  ITERATION  (FOFTS) 

STOP  663  IN  MAIN  WHEN  X .NE.  VARI(IPSI) 

STOP  665  IN  MAIN  AFTER  AN  INTEGRATION  ATTEMPT 

STOP  670  IN  MAIN  WHEN  A Cl  NEGATIVE 

NOTE  : PROGRAM  IS  CURRENTLY  CONFIGURED  FOR  A MAXIMUM 
200  STREAMLINE  SOLUTION 

IMPLICIT  REAL*8(A-H,0-Z) 

COMMON  /Al/  M, IX, IMAX.IPSI, MODEL, TE1.TE2 
COMMON  /A2/  P(200) ,DPDX(200) ,VARI(200) 

C FOLLOWING  7 VARIABLES  DIMENSIONED  BY  IMAX 

COMMON  /A3/  EVIINF(25) ,THETAI(25) ,MUI(25) ,FI(25) ,DELHI(25) , 

* CIINF(25) ,LI(25) 

COMMON  /A4/  R.MUINF, DELTA , LAMSQ , OMEGSQ , OMEGA, MU, T.U.TINF 
C FOLLOWING  2 VARIABLES  DIMENSIONED  BY  (LMAX  IN  LI, IMAX) 

COMMON  /A5/  EPSIIL(20 , 25) ,GIL(20,25) ,CID(200,4) 

COMMON  /A6/  VAR(52) ,CUVAR(52) ,DER(51) 

C FOLLOWING  4 VARIABLES  DIMENSIONED  BY  JMAX 

COMMON  /A7/  MJ(50) ,EJ(50) ,AJ(50) ,BJ(50) .DIRECT (50) 

C FOLLOWING  3 VARIABLES  DIMENSIONED  BY  IMAX 

COMMON  /A8/  TVI (25) ,NI (25) , DGENI (25) ,BI (25) 

C EVIS (IMAX) 

COMMON  /A9/  EVIS (25) , XPST (100) 

C FOLLOWING  3 VARIABLES  DIMENSIONED  BY  ( IMAX+1 , JMAX)  OR  (IMAX, JMAX) 

COMMON  /A10/  NUIJ(26 , 50) , AIJ(25 , 50) ,NUPIJ(25 , 50) 

C FOLLOWING  3 VARIABLES  DIMENSIONED  BY  (IMAX, JMAX) 

COMMON  /All/  SIGIK(25 , 25)  , ALPIK(25 , 25) , BETAIK(25 , 25) 

COMMON  /A12/  SINTM(200) , COSTM(200) ,RSM(200) ,RCM(200) ,X1(200) 

* , ZSM(200) 

COMMON  /A13/  DELX, ZSTERM, IZTERM, NSR, MW, SP , TS 

COMMON  /A14/  EINF, PINF.RHOINF, VINF, E, JMAX,KEYINT,RHO,HSTAG 

COMMON  /A15/  PFTL,KITR1,NIP(25) ,UP(25) 

COMMON  /A16/  IUNEG,WE(25) ,WEXE(25) ,WEYE(25) ,WEZE(25) 

COMMON  /A17/  ELB , SPEC , CJ , TPREV , HPREV , HCHECK , TCHECK 

COMMON  /A18/  ITNEG.IEXP 

COMMON  /A20/  WE1.WE2 

COMMON  /A19/  ELE1(51) ,ELE2(51) , NERR 

C DELI (IMAX) 

DIMENSION  DELI (25) 

DIMENSION  RUT(200) ,PSISTG(200) 

DIMENSION  CIG(25 ,11) ,EIG(25,11) 

DIMENSION  PSIG(ll) ,TG(11) ,HG(11) , CIT(ll) , EIT(ll) , EG(ll) 

C CM (IMAX), Cl ( IMAX), EVI( IMAX) 

DIMENSION  CM(25) ,CI(25) , EVI (25) 

EQUIVALENCE  (VAR(l) ,XVAR) , (VAR(2) ,H) , (VAR(3) , Cl (1) ) 

REAL* 8 MUI , MUINF , MU , MINF , MINFSQ , LAMBDA , LAMSQ 
CHARACTER*30  INFILE , OUTFL1 , OUTFL2 , OUTFL3 
CHARACTER* 3 0 SPECIE(25) ,REACT(50) 

C OPEN  GENERAL  INPUT  FILE  CREATED  BY  INPUT. FOR 

OPEN  (UNIT-106 , FILE-' GEN. INPUT' , STATUS-' OLD ' ) 

C READ  INTERACTIVE  INPUTS  FROM  GEN. INPUT 

READ (106 ,*)  IPF.M, NSR, IANS, MW, MODEL, IQ3 , IQ1 , IQ2 , IQ4 , 

* IQ5 , IQ7 , IQ6 , IQ8 , IQ9 

READ(106 ,*)  IS1,IS2,IS3,IS4,IS5,IS6 
READ ( 106 , *)  XI , DELX , ZSTERM , VINF , PINF , TINF 
IF  (IQ4.EQ.0)  READ (106, 20)  INFILE, OUTFL1 , OUTFL2 


IF  (IQ4.GT.0)  READ(106 , 18)  INFILE , 0UTFL1 , OUTFL2 , OUTFL3 
18  FORMAT ( IX , 4 ( A30 , 2X) ) 

20  FORMAT ( IX , 3 ( A30 , 2X) ) 

CLOSE(106) 

NSR1  - NSR  + 1 

NERR  - 0 

ITNEG  - 0 

I EXP  - 0 

NEG  - 0 

IUNEG  - 0 

DO  21  I - 1,52 

VAR(I)  - 0.0 

CUVAR(I)  - 0.0 

IF  (I.EQ.52)  GO  TO  21 

DER(I)  - 0.0 

ELE1(I)  - 0.0 

ELE2 ( I ) - 0.0 

21  CONTINUE 

OPEN  (UNIT-7 , FILE-INFILE , STATUS- ' OLD ' ) 

OPEN  (UNIT-8  , FILE-OUTFL1 , STATUS- ' UNKNOWN ' ) 

OPEN  (UNIT-15, FILE- 'RADIN1.DAT'  .STATUS- 'UNKNOWN') 

READ  INPUT 

READ ( 7 , * ) IMAX.JMAX.R, GAMMA 
READ (7,*)  NXPST , CIMAX , PHMAX , TCHCKT , HCHCKT 
NXCON  - NXPST  - 1 
WRITE(15 , 40)  OUTFL3 
40  FORMAT (A30) 

IQ10-1 

WRITE ( 15 , *)  MODEL , IQ3 , VINF , PINF , TINF 

WRITE ( 15 , *)  NXPST , NXCON , IMAX , IQ4 , IQ5 , IQ6 , IQ8 , IQ9 , IQ10 
DO  42  I - 1 , IMAX 

READ ( 7 , * ) THETAI (I) ,MUI(I) ,FI(I) .DELHI (I) ,CIINF(I) ,LI(I) ,DGENI(I) 

* , DELI ( I ) , EVI (I) ,BI(I) 

42  WRITE(15 ,*)  MUI(I) 

DO  45  J - 1 , JMAX, 2 

45  READ(7 ,*)  MJ (J) , AJ (J) , BJ (J) , EJ (J) .DIRECT (J) 

DO  48  J - 2, JMAX, 2 
48  READ (7,*)  MJ(J) .DIRECT(J) 

IMAX21  - 2*IMAX  + 1 
DO  51  I - 1.IMAX21 
51  READ ( 7 , * ) ELE1(I) ,ELE2(I) 

DO  54  I - I, IMAX 

54  READ(7,*)  (AIJ(I,J),J  - l.JMAX) 

DO  57  J - 1 , JMAX 

57  READ (7 ,*)  (NUIJ(I,J),I  - l.IMAX+l) 

DO  60  J - 1 , JMAX 

60  READ (7 ,*)  (NUPIJ (I , J) , I - l.IMAX) 

DO  63  I - 1 , IMAX 

63  READ (7 ,*)  (ALPIK(J.I) ,J  - l.IMAX) 

DO  66  I - l.IMAX 

66  READ (7 ,*)  (BETAIK(J , I) , J - l.IMAX) 

DO  69  I - l.IMAX 

69  READ (7 ,*)  (SIGIK(J.I) ,J  - l.IMAX) 

DO  72  I - l.IMAX 
LI  I - LI  (I) 

WRITE(15 ,*)  LII 

READ (7 , *)  (GIL(L.I) ,L  - l.LII) 

72  WRITE(15 , *)  (GIL(L.I) ,L  = l.LII) 

DO  75  I - l.IMAX 
LII  - LI (I) 


WRITE ( 15 ,*)  LI I 

READ(7,*)  (EPSIIL(L.I)  ,L  - l.LII) 

75  WRITE(15 , *)  (EPSIIL(L,I),L  - l.LII) 

IF  (IANS.EQ.l)  THEN 

NXPST  - 4 

XPST(l)  - (IS3  - NSR)*DELX 
XPST(2)  - (IS4  - NSR)*DELX 
XPST(3)  - (IS5  - NSR)*DELX 
XPST(4)  - (IS6  - NSR)*DELX 
GO  TO  78 
ENDIF 

DO  76  I - 1, NXPST 
XPST(I)  - DELX*I 

76  WRITE(15 ,*)  I.XPST(I) 

78  DO  80  I - l.IMAX 

80  READ(7 ,*)  NIP(I),UP(I),WE(I),WEXE(I),WEYE(I),WEZE(I) 

IMAXP2  - I MAX  + 2 

C SUM  OF  CIINF  SHOULD  BE  1.0 

SUM  - 0.0 
DO  81  I - l.IMAX 

81  SUM  - SUM  + CIINF(I) 

IF  (SUM. EQ. 1.0)  GO  TO  85 
WRITE(*,82)  SUM 

82  FORMAT (IX, 'SUM  OF  CIINF(I)  SHOULD  BE  1:  IT  IS  - \E11.4,'  STOP  1') 

STOP 

C STOP  1 

85  HCHECK  - HCHCKT 
TCHECK  - TCHCKT 

C READ  IN  AND  WRITE  OUT  SPECIES  AND  REACTIONS 

DO  88  I - l.IMAX 
88  READ(7 , 90)  SPECIE(I) 

90  FORMAT (A30) 

WRITE (8 ,95) 

WRITE (* , 95) 

95  FORMAT (//) 

WRITE(8 , 100) 

WRITE(* , 100) 

100  FORMAT (14X, 'SPECIES '/) 

DO  110  I - l.IMAX 
105  F0RMAT(1X, 15 , 11X.A30) 

WRITE(* , 105)  I , SPECIE(I) 

110  WRITE(8 , 105)  I , SPECIE(I) 

WRITE(*,95) 

WRITE(8 , 95) 

DO  112  I - l.JMAX 
112  READ (7 , 90)  REACT ( I ) 

WRITE(* , 115) 

WRITE(8 , 115) 

115  FORMAT ( 14X , ' REACTIONS ' /) 

DO  120  I - l.JMAX 
WRITE(*, 125)  I , REACT ( I ) 

120  WRITE(8 , 125)  I,REACT(I) 

125  F0RMAT(1X, 15 , 8X,A30) 

WRITE(*,95) 

WRITE(8 , 95) 

CLOSE(7) 

C PRINT  INPUT 

WRITE(8 , 135)  HCHCKT , TCHCKT , PHMAX 
WRITE (*,135)  HCHCKT, TCHCKT, PHMAX 

135  FORMAT (IX, 'HCHCKT  - ', Ell . 4 , 4X, ' TCHCKT  - ' , Ell . 4 , 4X, ' PHMAX  - ', 


* Ell. 4/) 

WRITE(8 , 140)  XI.CIMAX.NXPST 
WRITE (*,140)  XI.CIMAX.NXPST 

140  FORMAT (IX, 'XI  - ' .E11.4.8X, 'CIMAX  - ' .Eli. 4, 5X, 'NXPST  - ',13//) 
DO  141  I - 1 , IMAX21 

WRITE(*, 142)  I , ELE1 ( I ) , I , ELE2 ( I ) 

141  WRITE (8 , 142)  I , ELE1(I) , I , ELE2 (I) 

142  FORMAT ( IX, 'ELE1( ',12, ')  - ' , Ell . 4 , 5X, ' ELE2( ' , 12 , ' ) - ' .E11.4) 
WRITE(8 , 95) 

WRITE(*,95) 

DO  143  I - 1, NXPST 
WRITE(* , 144)  I,XPST(I) 

143  WRITE (8 , 144)  I,XPST(I) 

144  F0RMAT(1X, 'XPST(' ,13, ')  - '.Ell. 4) 

WRITE (8 ,95) 

WRITE(*,95) 

WRITE (8 , 145)  IMAX.JMAX.M 
WRITE(*, 145)  IMAX.JMAX.M 

145  FORMAT ( IX, ' IMAX  - ' ,12 , 11X, ' JMAX  - ',I2,13X,'M  - ',12/) 

WRITE (8,150)  DELX , ZSTERM , IPF , R , PINF , TINF , VINF , GAMMA 
WRITE ( * , 150 ) DELX , ZSTERM , IPF , R , PINF , TINF , VINF , GAMMA 

150  FORMAT (IX, 'DELX  - ', Ell . 4 , 2X, ' ZSTERM  - \E11.4,2X, 

* ' PRINT  FREQ.  - ',I3,3X,'R-  ' , Ell . 4 , //, IX, ' PINF  - '.E11.4, 

*2X, 'TINF  - ' ,E11.4,4X, 'VINF  - ' , Ell . 4 , 2X, ' GAMMA  - ',E9.3//) 
WRITE(8 , 155) 

WRITE(*, 155) 

155  FORMAT (16X, 'MUI' ,8X, ' THETAI ' , 7X , ' DGENI ' , 10X , ' FI ' ,9X, 'DELHI'/) 

DO  157  I - 1 , IMAX 

WRITE(* , 160)  I , MUI ( I ) , THETAI ( I ) , DGENI ( I ) , FI ( I ) ,DELHI(I) 

157  WRITE(8 , 160)  I,MUI(I) ,THETAI(I) ,DGENI(I) ,FI(I) ,DELHI(I) 

160  FORMAT ( IX, 12, 8X, 5 (Ell. 4, 2X)) 

WRITE(8 , 95) 

WRITE(-8 , 161) 

WRITE(*,95) 

WRITE(* , 161) 

161  FORMAT (16X, 'DELI' ,8X,  'CIINF'  ,9X,  'EVI' ,10X, 'LI' ,11X, 'BI'/) 

DO  163  I - 1 , IMAX 

WRITE(* , 164)  I , DELI ( I ) , CIINF ( I ) , EVI ( I ) , LI ( I ) ,BI(I) 

163  WRITE(8 , 164)  I,DELI(I) ,CIINF(I) ,EVI(I) ,LI(I)  ,BI(I) 

164  FORMAT (IX, 12 , 8X, 3 (Ell . 4 , 2X) , 3X, 13 , 7X, Ell . 4) 

WRITE(8 , 95) 

WRITE(8 , 165) 

WRITE(*,95) 

WRITE(*. 165) 

165  FORMAT ( 8X , 'NIP' ,9X, 'UP' ,10X,  'WE' ,10X, 'WEXE' ,9X, 'WEYE' ,8X, 'WEZE'/) 
DO  167  I - 1 , IMAX 

166  FORMAT (IX, 12 , 5X, 13 ,4X,  E10 .4 , 2X, E10.4, 3X, E10.4 , 3X, E10 .4, 2X, E10 . 4) 
WRITE(*, 166)  I ,NIP(I) ,UP(I) ,WE(I) ,WEXE(I) ,WEYE(I)  ,WEZE(I) 

167  WRITE(8 , 166)  I ,NIP(I) ,UP(I) ,WE(I) ,WEXE(I) ,WEYE(I) ,WEZE(I) 

WRITE(8 , 95) 

WRITE (8 ,170) 

WRITE(*,95) 

WRITE(* , 170) 

170  FORMAT (12X, 'MJ' ,9X, 'AJ' ,14X, 'BJ' ,15X, ' E J ' ,10X, 'DIRECTION' ,/, 

* 69X, 'F-l.B-2'/) 

DO  180  J - 1, JMAX, 2 

175  FORMAT (IX, 12 , 2X, 18 , 3 (2X, E15 .6) , 5X, F5 . 2) 

URITE(*, 175)  J ,MJ(J) ,AJ (J) , BJ (J) ,EJ(J) ,DIRECT(J) 

180  WRITE(8 ,175)  J ,MJ (J) , AJ(J) , BJ (J) , EJ (J) , DIRECT(J) 

WRITE(8 , 95 ) 


WRITE(8 , 181) 

WRITE(* , 95) 

WRITE(*, 181) 

181  FORMAT (12X, 'MJ' ,6X, 'DIRECTION' ,/,21X, 'F-l.B-2'/) 

DO  183  J - 2.JMAX.2 

182  FORMAT (IX, 12 , 2X, 18 , 8X, F5 . 2) 

WRITE(*,182)  J , MJ ( J ) , DIRECT ( J ) 

183  WRITE(8 , 182)  J ,MJ (J) , DIRECT (J) 

WRITE(8 , 95) 

WRITE(*,95) 

DO  187  I - l.IMAX 
LI I - LI (I) 

DO  186  L - l.LII 

WRITE(8 , 185)  L, I ,GIL(L, I) , L, I ,EPSIIL(L,  I) 

WRITE(* , 185)  L, I ,GIL(L, I) , L, I , EPSIIL(L, I) 

185  F0RMAT(1X, 'GIL(' ,12, ' , ' ,12, ')  - ' ,E11.4,4X, 

* ' EPSIIL( ' , 12 , ' , ' , 12 , ' ) - ' ,E11.4) 

186  CONTINUE 

187  CONTINUE 
WRITE (8 ,95) 

WRITE(*,95) 

DO  200  I - l.IMAX 
DO  196  J - l.JMAX 
WRITE(*, 195)  I , J ,AIJ (I , J) 

WRITE(8 , 195)  I , J ,AIJ (I , J) 

195  F0RMAT(1X, ' AIJ ( ' , 12 , ' , ' , 12 , ' ) - '.E11.4) 

196  CONTINUE 

200  CONTINUE 
WRITE(8 , 95) 

WRITE(*,95) 

DO  205  I - 1 , IMAX+1 
DO  202  J - l.JMAX 

WRITE(8 , 201)  I,J,NUIJ(I,J) , I , J .NUPIJ (I , J) 

WRITE(* , 201)  I , J , NUI J ( I , J ) , I , J , NUPIJ ( I , J ) 

201  F0RMAT(1X,'NUIJ(' ,12,',' ,12,')  - ' , 15 , 9X, 'NUPIJ ( ' , 12 , ' , ' , 

* 12,')  - ' ,15) 

202  CONTINUE 
205  CONTINUE 

WRITE(8 , 95) 

WRITE(* , 95) 

DO  225  I - l.IMAX 
DO  220  J - l.IMAX 

WRITE(8 , 210)  I , J , SIGIK(I , J) , I , J ,ALPIK(I , J) , I , J ,BETAIK(I , J) 
WRITE(*, 210)  I, J.SIGIK(I.J) ,I,J,ALPIK(I,J) ,I,J,BETAIK(I,J) 

210  FORMAT (IX, ' SIGIK( ' , 12 , ' , ' , 12 , ' ) - '.E10.4.1X, 

*'ALPIK(' ,12, ' , ' ,12, ’)  - ' ,E10.4,1X, 'BETAIKC ,12, ' , ' ,12, ')  - ', 
*E10.4) 

220  CONTINUE 
225  CONTINUE 

WRITE (8 ,95) 

WRITE(8 , 230) 

WRITE(* , 95) 

WRITE(* , 230) 

230  FORMAT (7X, 25 ( ' * ' ) , ' END  INPUT  ' , 25 ( '*' )///) 

WRITE(8 , 231) 

WRITE(*, 231) 

231  FORMAT ( 2 5X, '+++  SHOCK  GEOMETRY  +++'//) 

NXPSTM1  - NXPST  - 1 


C 


CALL  SHOCKG  (NXPSTM1 , ITK) 


DEFINE  SHOCK  GEOMETRY 


c IZTERM  - NO.  OF  DELTA  X INCREMENTS  GENERATED  IN  SHOCKG 

IF  (IQ4.GT.0. AND. IZTERM. GT. 30)  THEN 
WRITE(*, 232)  IZTERM 

232  FORMAT (IX, 'IZTERM  - ' ,I4,2X, 'WITH  A RADIATION  MODEL  SELECTED' 

* ,/, IX, 'MAXIMUM  NO.  OF  STREAMLINES  .LE.  30') 

STOP 

ENDIF 

WRITE(8 , 95) 

WRITE (* ,95) 

IF  ( (NXPST  - 1.0) .LE. IZTERM)  GO  TO  237 
WRITE(*, 235) 

235  F0RMAT(1X, ' (NXPST- 1)  .GT.  IZTERM  : IT  MUST  BE  .LE.  TO  IZTERM',/, 

* IX, 'PHYSICAL  SPACE  CALCULATIONS  - SEE  DO  700  LOOP  : STOP  301'/) 

STOP 

WRITE(8 , 95) 

WRITE(*, 95) 

IF  (IZTERM. LE. 200)  GO  TO  241 
WRITE(*, 240) 

FORMAT (IX, 'IZTERM. GT. 200: CHGE  DIM  OF  P.DPDX  AND  VARI : STOP  301'/) 

STOP 

FREESTREAM  QUANITIES 

SUM  - 0.0 

DO  245  I - l.IMAX 
SUM  - SUM  + CIINF(I)/MUI(I) 

MUINF  - 1.0/SUM 
RHOINF  - MUINF*PINF/(R*TINF) 

AINF  - DSQRT(GAMMA*R*TINF/MUINF) 

MINF  - VINF/AINF 

FOR  EACH  I , SPECIE 

EINF  - 0.0 
DO  275  I - l.IMAX 
TEM  - DEXP (THETAI ( I ) /TINF) 

EVIINF(I)  - ( R*THETAI ( I ) ) / (MUI ( I ) * ( TEM  - 1.0))*FI(I) 

FOR  EACH  L,  REACTION  LEVEL 

GSUM  - 0.0 
GESUM  - 0.0 
LI I - LI (I) 

IF  (LII.LE.20)  GO  TO  255 
WRITE(*, 250)  LI I 

FORMAT (IX, 'LI I -',I3,2X,'A  LEVEL  IN  LI  ARRAY  IS  GREATER  THAN  20', 

* 2X,/, IX, 'YOU  NEED  TO  CHANGE  DIMENSION  OF  EPSIIL  AND  GIL') 

255  CONTINUE 

DO  265  L - l.LII 

TEM1  - DEXP(-EPSIIL(L,I)/TINF) 

GSUM  - GSUM  + GIL(L,I)*TEM1 
GESUM  - GESUM  + GIL(L, I)*EPSIIL(L, I)*TEM1 
265  CONTINUE 

EEIINF  - R/MUI ( I ) * ( GESUM/GSUM) 

EIINF  - 1 . 5*R*TINF/MUI ( I ) + FI(I)*R*TINF/MUI(I)  + EVIINF(I) 

* + EEIINF  + DELHI ( I ) /MUI ( I ) 

EINF  - EINF  + EIINF*CIINF(I) 

275  CONTINUE 

WRITE (8,280)  MUINF , RHOINF , AINF , TINF , PINF , VINF , MINF , EIINF, EINF , 

* EEIINF 

WRITE ( * , 2 8 0 ) MUINF , RHOINF , AINF , TINF , PINF , VINF , MINF .EIINF, EINF , 

* EEIINF 

280  FORMAT ( 2 4X, '+++  FREESTREAM  QUANTITIES  +++',///, 6X, 'MUINF  - '.E11.4 
*,3X, 'RHOINF  - 'E11.4.3X, 'AINF  - ' , Ell .4,//, 6X, 'TINF  - '.E11.4.3X, 

*' PINF  - ' , Ell . 4 , 3X, 'VINF  — ' , Ell . 4 , // , IX, 'MINF  - '.E10.4.2X, 

*' EIINF  - ' .E10.4.2X, 'EINF  - ', E10 .4 , 2X, ' EEIINF  - '.E10.4//) 


237 

240 
C 

241 
245 

C 

C 

250 


DO  285  I - l.IMAX 
WRITE(* , 286)  I , EVIINF(I) 

285  WRITE(8 , 286)  I.EVIINF(I) 

286  F0RMAT(1X, ' EVIINF( ' , 12 , ' ) - \E11.4) 

WRITE(8 , 95) 

WRITE(*, 95) 

C BEGIN  QUANTITIES  BEHIND  SHOCK  FOR  THE  RANGE  OF  X 

WRITE(8 , 290) 

WRITE(*,290) 

290  FORMAT ( 2 2X, '+++  QUANTITIES  BEHIND  SHOCK  +++',///, 5X, ' TS 9X, ' ES ’ , 

*9X, 'PS' ,7X, 'RHOS' ,8X, 'US' ,8X, 'PSIS' ,8X, 'HS'/) 

IF  (NXPST.GE. 3)  GO  TO  293 
WRITE(* , 291) 

STOP 

291  FORMAT ( IX, 'NXPST  - 2 - SURELY  SOME  PHYSICAL  SPACE  VALUES ',/, IX , 

* 'ARE  DESIRED  --  MAKE  IT  AT  LEAST  3 : STOP  2') 

293  OPEN  (UNIT-9  , FILE— OUTFL2 , STATUS- ' UNKNOWN ' ) 

OPEN  (UNIT-10 .FILE- 'STAG. DAT' , STATUS- 'UNKNOWN ' ) 

OPEN  (UNIT-11 .FILE- 'EVISC.DAT' , STATUS-' UNKNOWN ' ) 

C 

DO  385  IX  - l.IZTERM 

TEM  - SINTM(IX)**2 

LAMBDA  - RHOI NF*VINF*S INTM (IX) 

OMEGA  - PINF  + RHOINF*VINF**2*TEM 

DELTA  - EINF  + PINF/RHOINF  + (VINF**2*TEM)/2 . 0 

LAMSQ  - LAMBDA** 2 

OMEGSQ  - OMEGA**2 

MINFSQ  - MINF**2 

TEM  - TEM*MINFSQ 

TSG  - (TINF*(2 . 0*GAMMA*TEM  - (GAMMA  - 1 . 0) )*( (GAMMA  - 1.0) 

* *TEM  + 2 . 0 ) ) / ( ( GAMMA  + 1.0)**2*TEM) 

TOL1  - .001 

TOL2  - .0001 
MAXI  - 50 
C 

IF  (IQ3.EQ.1)  CALL  FOFTS1  (MAXI , TOL1 , TOL2 , ICODE, TSG) 

IF  (IQ3.GT.1)  CALL  FOFTS23  (MAXI ,T0L1 , TOL2 , ICODE , TSG , IQ1 , IQ2 , IQ3) 

C 

IF  (ICODE. EQ.l)  WRITE(*, 330)  TSG 

330  FORMAT ( IX, '****  MAXIMUM  ITERATION  EXCEEDED  IN  FOFTS  ****',//, 

* IX, 'LAST  ITERATED  VALUE  OF  TSG  WAS  '.E15.6,'  : STOP  321'/) 

IF  (ICODE. EQ. 2)  WRITE(*,335) 

335  FORMAT (IX, '*****  DERIVATIVE  - 0.0  IN  FOFTS  *****  : STOP  321'/) 

IF  (ICODE. EQ.l. OR. ICODE. EQ. 2)  STOP 

C STOP  321 

IF  (IX. EQ.l)  WRITE(15 , *)  TSG 
TS  - TSG 
ES  - 0.0 

DO  360  I - l.IMAX 

IF  (M.EQ.l)  EVIS(I)  - EVIINF(I) 

IF  (M.EQ.l)  GO  TO  345 
TEM  - DEXP ( THETAI ( I ) /TS ) 

EVIS(I)  - (R*THETAI (I) )/(MUI (I)*(TEM  - 1.0))*FI(I) 

345  SUMG  - 0.0 
SUMGE  - 0.0 
LI I - LI (I) 

DO  350  L - l.LII 

TEM1  - DEXP(-EPSIIL(L,I)/TS) 

SUMG  - SUMG  + TEM1*GIL(L,I) 

350  SUMGE  - SUMGE  + TEM1*GIL(L, I)*EPSIIL(L, I) 
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EEIS  - ( R/MUI ( I ) ) * ( SUMGE/SUMG ) 

EIS  - ( 1 . 5*R*TS ) /MUI ( I ) + (FI(I)*R*TS)/MUI(I)  + EVIS(I) 

* + EEIS  + DELHI ( I ) /MUI ( I ) 

IF  (IQ3.EQ.1)  THEN 
ES  - ES  + EIS*CIINF(I) 

ELSE 

ES  - ES  + EIS*CID(IX, I) 

ENDIF 

360  CONTINUE 

PS  - DSQRT(OMEGSQ  - 2 . 0*LAMSQ*( DELTA  - ES)) 

RHOS  - (MUINF*PS)/(R*TS) 

US  - VINF*COSTM ( IX) 

PSIS  - (RHOINF*VINF*RSM(IX)**2)/2 . 0 
HS  - PS/RHOS  + ES 

WRITE(10,*)  IX.TS.ES, PS ,RHOS .US, PSIS ,HS 
WRITE(8 , 365)  TS , ES , PS ,RHOS ,US , PSIS ,HS 
WRITE (*,365)  TS , ES , PS , RHOS . US , PSIS , HS 

365  FORMAT ( IX , 7 (E9 . 4 , 2X) ) 

WRITE(9 , 366)  IX 

366  FORMAT (IX, 'FOR  IZTERM  - ',13//) 

DO  370  I - l.IMAX 

WRITE(9 , 367)  I,EVIS(I) 

367  FORMAT (13X, 'EVIS(' ,12, ')  - '.Ell. 4) 

370  CONTINUE 

WRITEU1,*)  (EVIS(I)  , I - l.IMAX) 

WRITE(9 , 620) 

385  CONTINUE 
C 

CLOSE(9) 

CLOSE(IO) 

CLOSE(ll) 

OPEN  (UNIT-10 , FILE- ' STAG . DAT ' , STATUS- ' OLD ' ) 

OPEN  (UNIT-11, FILE- 'EVISC.DAT' , STATUS- ' OLD ' ) 

C COMPUTE  PRESSURE  DISTRIBUTION  FOR  EACH  PSI 

OPEN  (UNIT-12,  FILE- 'PRESS.  DAT’  , STATUS- 'UNKNOWN ' ) 

DO  390  IPSI  - 1, IZTERM 
DO  388  IX  - 1, IZTERM 
IF  (IX. EQ. IPSI)  XX  - XI (IX) 

READ(10 ,*)  IXT, TS , ES , PS , RHOS , US , PSIS  ,HS 
IF  (IXT. LT. IPSI)  GO  TO  388 
IF  (IXT. EQ. IPSI)  PSISHK  - PSIS 
IF  (IPSI. EQ. IX)  THEN 
P(IX)  - PS 
GO  TO  388 
ENDIF 

P(IX)  - PS  + US/(RCM(IX)*RSM(IX))*(PSISHK  - PSIS) 

388  CONTINUE 
CLOSE (10) 

OPEN  (UNIT-10 , FILE- ' STAG . DAT ' , STATUS- ' OLD ' ) 

WRITE(12 , *)  XX, (P(IX) ,IX  - 1, IZTERM) , IPSI, IZTERM 
390  CONTINUE 
CLOSE (12) 

OPEN  (UNIT-12,  FILE-' PRESS. DAT' , STATUS- ' OLD ' ) 

OPEN  (UNIT-13,  FILE-' DPDX.DAT' , STATUS- ' UNKNOWN ' ) 

: COMPUTE  DPDX  AND  VARI 

DO  404  IPSI  - 1, IZTERM 

READ (12 , *)  X, (P(I) ,1-1, IZTERM) , IPI , IZTERM 
ITHIS  - 0 

DO  401  IX  - IPSI, IZTERM 
IF  (IX. EQ. IPSI)  XT  - X 
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IF  (IX.GT.IPSI.AND.IPSI.lt.  (NSR+2))  XT  - XT  + DELX/NSR 
IF  (IX.GT. IPSI .AND. IPSI ,GT. (NSR+1) ) XT  - XT  + DELX 
I THIS  - I THIS  + 1 
VARI(ITHIS)  - XT 

401  CONTINUE 

DO  403  IX  - IPSI , IZTERM 

C DIFFERENTIATE 

IF  (IX. NE. IPSI)  GO  TO  402 

DPDX(IX)  - (-  3 ,*P(IX)  + 4.*P(IX+1)  - P ( IX+2 ) ) / ( 2 . 0*DELX) 

GO  TO  403 

402  DPDX(IX)  - (-  P(IX-l)  + P(IX+1) )/(2 . 0*DELX) 

IF  ( IX. NE. IZTERM)  GO  TO  403 

DPDX(IX)  - (P(IX-2)  - 4.*P(IX-1)  + 3.*P(IX))/(2.0*DELX) 

403  CONTINUE 

WRITE(13 , *)  (DPDX(I) , 1-1 , IZTERM) , IPSI , IZTERM 

404  CONTINUE 
CLOSE(13) 

CLOSE(12) 

OPEN  (UNIT-12 , FILE- ' PRESS . DAT ' , STATUS- ' OLD ' ) 

OPEN  (UNIT-13,  FILE- 'DPDX.DAT' .STATUS- 'OLD' ) 

C 

DO  405  IX  - 1, IZTERM 
IF  (IX.EQ.l)  VARI(l)  - 0.0 
IF  (IX.EQ.l)  GO  TO  405 

IF  (IX. LT. (NSR+2))  VARI(IX)  - VARI(IX-l)  + DELX/NSR 
IF  (IX.GT. (NSR+1))  VARI(IX)  - VARI(IX-l)  + DELX 

405  CONTINUE 
WRITE(8 , 95) 

WRITE(*,95) 

WRITE (8, 407)  ITK, NXPST 
WRITE(*,407)  ITK.NXPST 

407  FORMAT  ( IX, 'XXXXX  ITK  - ' , 13 , 5X, 'NXPST  - ',13,'  XXXXX'//) 

IF  (ITK.GE. (2+NXPST/4))  GO  TO  409 

WRITE(*,408) 

408  FORMAT  (IX, 'NO.  OF  X-S  IN  XPST  ARRAY,  ITK,  IS  .LT.  ,5*NXPST',/ 

* , IX, 'REEXAMINE  DELX, NXPST  AND  XPST  ARRAY  : STOP  301'/) 

STOP 

STOP  301 

C END  COMPUTATION  OF  QUANTITIES  BEHIND  SHOCK  ; INTEGRATE  ALONG  EACH  PSI 
C 

C VAR(l)  - XV AR 

C VAR(2)  - H, ENTHALPY  VAR(2)  MUST  BE  H,  WHICH  MAY  BE  + OR  - 

C 

C CONCENTRATION  OF  SPECIE 

C VAR(3)  - CI(1) 

C VAR(2+IMAX)  - CI(IMAX) 

C EQUILIBRIUM  VIBRATIONAL  ENERGY 

C VAR(2+IMAX+1)  - EVI(l) 

C VAR ( 2+IMAX+IMAX)  - EVI(IMAX) 

C 

409  WRITE(8 ,411) 

WRITE(* , 411) 

411  FORMAT (IX, 'NO.  OF  VIB.  LEVELS  TO  DISSOCIATION',/) 

DO  410  I - 1 , IMAX 

C TRUNCATE 

YIY  - FI ( I ) * ( DELI ( I ) /THETAI ( I ) + 1.0) 

NI  (I)  = AINT(YIY) 

WRITE(*,412)  I ,NI(I) 

410  WRITE(8 ,412)  I,NI(I) 


412  F0RMAT(11X, 'NI(' ,12, ')  - ',13) 

WRITE(* , 95) 

WRITE(8 , 95) 

MU  - 0.0 

N - 1 + 2*1MAX 

IF  (M.EQ.O)  N - N - IMAX 

C INITIALIZE 

WRITE(8 , 415)  IZTERM 
MRITE(*,415)  IZTERM 
415  F0RMAT(1X, 'IZTERM  -’ ,14///) 

WRITE (8, 417) 

WRITE(*,417) 

417  FORMAT (IX, 'COUPLED  VIBRATION-DISSOCIATION  MODELS' ,//,12X, 

* 'TYPE' ,11X, 'NO. ' ,//,9X, 'VIB.  EQUIL. ' , 8X,  ’ 0' ,/, 12X, ' CVD' , 13X, 

* '1' , /, 12X, ' CVDV' , 12X, ’ 2 ' ,/,6X,  'CVDV-Preferential'  ,5X,  '3' ,/, 

* 12X, 'PARK' ,12X, '4'///) 

WRITE (8, 418) 

WRITE(*,418) 

418  FORMAT (7X, 'SHOCK  JUMP  CONDITION  MODELS' ,//, 12X, 

* 'TYPE' ,11X, 'NO. ' ,//,6X, 'CHEMISTRY  FROZEN' ,6X, '1' ,/,5X, 

*'N2  FROZEN,  02  DISS . ' ,4X, ' 2' ,/, 7X, 'N2  AND  02  DISS . ' , 6X, ' 3 ' //) 

IF  (MW. EQ . 1)  THEN 
WRITE(*,419) 

WRITE(8 ,419) 

419  FORMAT (3X,  'MILLIKAN  AND  WHITE  DATA  FOR  N2  WAS  SELECTED'/) 

ENDIF 

KSTAG  - 0 
ISTAG  - 0 
XPST(l)  - DELX 

XPST(NXPST)  - VARI( IZTERM)  + 100.0 
SUMCI  - 0.0 
WRITE(* , 95) 

WRITE (8 , 95) 

LPS1  - 1 
IPSI  - 0 

OPEN  (UNIT-14 , FILE- ' RHORT . DAT ' , STATUS- ' UNKNOWN ' ) 

OPEN  (UNIT-16, FILE- 'RADIN2.DAT'  , STATUS- 'UNKNOWN ' ) 

C BEGIN  EACH  STREAMLINE  COMPUTATION  HERE 

420  IPSI  - IPSI  + 1 

IF  (IPSI. EQ. IZTERM)  GO  TO  735 
425  KIPF  - 0 

C ISTAG  - 2 FOR  STREAMLINE  DELX 

IF  (ISTAG. EQ.l)  ISTAG  - 2 
READ(10,*)  IX,TS , ES , PS ,RHOS ,US , PSIS ,HS 
READ(11,*)  (EVIS(I).I  - 1 , IMAX) 

IF  (IPSI. EQ.l)  HSTAG  - HS 
CJ  - XI 
SPEC  - 0.0 

c EVALUATE  DERIVATIVES  WHEN  SPEC  - 0.0 

II  - 0 

C USE  SHOCK  VALUES  FOR  INITIAL  COMPUTATION  ON  EACH  STREAMLINE 

KEYINT  - 0 
IX  - 0 
T - TS 

IF  (M.EQ.O)  GO  TO  450 
DO  445  I - 1 , IMAX 
445  TVI(I)  - TINF 
TE1-TINF 
GO  TO  460 
DO  455  I - 1 , IMAX 
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455  TVI(I)  - TS 
TE1-TS 

460  RHO  - RHOS 

IF  (IQ3.GT.1)  THEN 
SUM  - 0.0 
DO  462  I - l.IMAX 

462  SUM  - SUM  + CID(IPSI , I)/MUI (I) 

MU  - 1.0/SUM 
ENDIF 

IF  (IQ3.EQ.1)  MU  - MUINF 
U - US 

DO  465  I - l.IMAX 
MM  - 2 + I 
K - IMAX  + MM 
VAR(MM)  - 0.0 

IF  (IQ3.EQ.1)  VAR(MM)  - CIINF(I) 

IF  (IQ3.GT.1)  VAR(MM)  - CID(IPSI.I) 

VAR(K)  - 0.0 

IF  (M.EQ.O)  VAR(K)  - EVIS(I) 

IF  (M.EQ.l)  VAR(K)  - EVIINF(I) 

EVI(I)  - VAR(K) 

465  CONTINUE 

C COMPUTE  S EXPONENT  FOR  PARK  MODEL 

IF  (MODEL. EQ. 4)  THEN 
SP  - 3 . 5*DEXP ( - 5000 . 0/TS ) 

ENDIF 
E - ES 
H - HS 

IF  ((IPSI.EQ. (NSR+1)) .AND. (ISTAG.EQ.O))  GO  TO  635 
READ(12 ,*)  X, (P(L) , L— 1 , IZTERM) , IPSI , IZTERM 
READ(13 ,*)  (DPDX(L) ,L-1, IZTERM) , IPSI, IZTERM 
VAR(l)  - X 

C OMIT  PS I - 0.0  STREAMLINE  FOR  NOW  - PICK  IT  UP  LATER 

IF  (X.NE.0.0)  GO  TO  490 
IG  - 0 

WRITE(*, 725) 

WRITE(8 , 725) 

GO  TO  730 

490  IF  (IANS.EQ.l)  THEN 

IF  ((IPSI. EQ.IS1) .OR. (IPSI.EQ. IS2) .OR. (IPSI.EQ. IS3))  GO  TO  492 
IF  ((IPSI. EQ.IS4) .OR. (IPSI.EQ. IS5). OR. (IPSI.EQ. IS6))  GO  TO  492 
GO  TO  730 
ENDIF 

492  IF  (DABS (X  - VARI (IPSI) ) . LE . 1 . 0E-06)  GO  TO  500 
WRITE(* , 495)  IPSI ,X, VARI (IPS I) 

495  FORMAT  (IX, 'IPSI  - ',I3,2X,'X-  ' , E10 . 5 , 2X,-  'VARI  (IPSI)  - '.E10.5, 

*//.lX,'X  AND  VARI (IPSI)  SHOULD  BE  EQUAL  : EXAMINE  GENERATION  OF  X 
* AND  VARI  IN  MAIN  : STOP  663'/) 

STOP 

C STOP  663 

C INITIALIZE 

500  IF  (IANS.EQ.l)  THEN 

IF  ((IPSI. EQ.IS1) .OR. (IPSI.EQ. IS2) .OR. (IPSI.EQ. IS3))  GO  TO  501 
IF  ((IPSI. EQ.IS4). OR. (IPSI. EQ.IS5). OR. (IPSI. EQ.IS6))  GO  TO  501 
GO  TO  730 
ENDIF 

501  ELB  - 0.0 
SPEC  - 0.0 

IF  (VAR(l) . GT.XPST(LPSl) ) LPS1  - LPS1  + 1 
LPS2  - LPS1 
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505  IX  - IX  + 1 


CALINTH  - MODIFIED  RUNGE-KUTTA 


C 

CALL  CALINTH  (N , CIMAX, PHMAX) 

C 

IF  (NERR.EQ.O)  GO  TO  575 
IF  (NERR.EQ.l)  WRITE(*,565)  CJ,N 
565  FORMAT (IX, 'BAD  INPUT  IN  CALINTH' ,/, IX, 'CJ  - ' , E10 . 5 , 2X, 'N  - ',14 
* ,/, IX, ' STOP  665'/) 

IF  (NERR.EQ.2)  WRITE(*,570) 

570  FORMAT (IX, 'EXAMINE  ELE1  AND  ELE2  IN  CALINTH  : STOP  665'/) 

IF  ((NERR.EQ.l) .OR. (NERR.EQ.2))  STOP 

c STOP  665 

575  IF  (IX.EQ.l)  THEN 

IF  (IQ3.NE.1)  THEN 
IF  (IQ2.EQ.1)  TE  - TINF 
IF  (IQ2.EQ.2)  TE  - TS 
TE1  - TE 
TE2  - TE 
ELSE 

TE  - TINF 
TE1  - TE 
TE2  - TE 
END  IF 
END  IF 

C ELECTRON  TEMPERATURE  MODEL 

IF  (IX.EQ.l)  GO  TO  576 
C CORR  - 4 . 23E-06*(T**( -2 . 88) ) 

CN  - RHO*6 . 02252E+23 
CNN  - CN*VAR ( 5 ) /MUI ( 3 ) 

CNO  - CN*VAR(6)/MUI (4) 

TE  - DLOG ( 1 . + 10 . l/( (CNO+CNN)*CORR) ) 

TE  - T/(l . + TE*T/85000 . ) 

ITRTE-0 

FNA-CN*VAR ( 5 ) /MUI ( 3 ) 

FNI— CN*VAR(11)/MUI (9) 

FNE-CN*VAR ( 9 ) /MUI ( 7 ) 

FNM-CN*VAR ( 3 ) /MUI ( 1 ) 

FOA-CN*VAR ( 6 ) /MUI (4 ) 

FOI-CN*VAR(12) /MUI (10) 

FOM-CN*VAR (4 ) /MUI ( 2 ) 

EI-2 . 3322D-11 

EO-2 . 1735D- 11 

FAV-6 . 023D23 

SA-1.52D-15 

Fl-0 

F2-0 

WE2-WE2*U*FAV/VAR ( 9 ) 

WE1-WE1*U*FAV/VAR(9) 

FO-O 

574  ITRTE-ITRTE+1 

IF(ITRTE . GT. l)GO  TO  571 
KK-1 

569  KK-KK+1 

IF(KK.GT. 50)TEl-2000 
IF(KK.GT.50)GO  TO  576 
TE=1000*KK 

571  SM-0 . 5355D-19*TE+. 696D-15 
IF(ITRTE. GT . 50)GO  TO  573 
SI-1 . 53614D08*(TE**3) /FNE 
SI-DSQRT(SI) 
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SI-(4 . 38384D-06/(TE**2) )*DLOG(SI) 

FKF-4 . 16D13*(TE**(  0. 50D0) )*DEXP(-1. 20D05/TE) 

FK1-5 . 49D13*(TE**(  0 . 50D0) )*DEXP( - 1 . 045D05/TE) 

FKB-2 . 3D21*(TE**( -1 . 0D00) )*DEXP(4 . 9D4/TE) 

FK5-1 . 5 3D22* (TE** ( - 1 . ODO) ) *DEXP (5 . 3D4/TE) 

WEA-FKF*FNA - FKB* ( FNI/FAV ) *FNE 
W2E-FK1*F0A - FK5* ( FOI/FAV) *FNE 

SX-  ( FNA+FOA)  *SA+  ( FNI+FOI ) *S  1+  ( FNM+FOH)  /2 . ODO*SM 
WEA-WE1 
W2E-WE2 

W2-DER ( 8 ) *U*FAV/VAR( 9 ) 

W1-WEA+W2E 
W1-W2 

C WRITE(*, 563)KK,ITRTE,WEA,W2E,W1 

563  FORMAT ( ' MAIN' , 215 , 3E11 . 3) 

FE-T- 1 . 2 3 3 5 7D - 10/SX/DSQRT ( TE ) * ( WEA*EI+W2E*E0+W1*3 . 45D-16*TE)  -TE 

IF(ITRTE.GT. 1)G0  TO  568 

IF( (FE/DABS (FE)*FO) ,LT.O.DOO)GO  TO  567 

FO-FE 

TO-TE 

GO  TO  569 

567  Fl-FE 
Tl-TE 

566  TE- ( T0*F1 - T1*F0 ) / (FI - FO ) 

IF  (DABS(TE-Tl) . LT.1.DOO)GO  TO  573 
IF(DABS (TE-TO) .LT.1.DOO)GO  TO  573 
GO  TO  574 

568  IF( (FE*FO) . LT. 0 . ODOO)GO  TO  564 
TO-TE 

FO-FE 
GO  TO  566 

564  Fl-FE 
Tl-TE 

GO  TO  566 
C 573  CONTINUE 

573  IF  (TE.GT.T)TE-T 
TE1  - TE 

IF  (ITRTE. GT. 50)WRITE(*, 572) 

572  FORMAT ( ' ' , 'TE  DID  NOT  CONVERGE’) 

CN2  - RH0*6 . 02252E+23*VAR(3)/MUI (1) 

A - DLOG ( 1 . 01D+01 ) - DL0G(CN2)  - DL0G(6 . 4D+00) 

• * - 59 . *DLOG(1,OD+Ol)  + 19 ,*DL0G(TVI(1) ) 

A - DEXP(A) 

TE  - DLOG ( 1 . + A) 

TE  - TVI (1)/(1 . + TE*TVI (l)/85000 . ) 

TE2  - TE 
C 

576  IF  (IX.EQ.l)  GO  TO  580 

IF  ( (IPSI . EQ. (NSR+1) ) .AND . (IX. EQ. (NSR+1) ) ) GO  TO  580 
IF  (VAR(l) .GE.VARI(IZTERM))  GO  TO  580 
IF  ( (IPSI. LT. (NSR+1)) .AND. (VAR(l) .GE.DELX))  GO  TO  580 
KIPF  - KIPF  + 1 
IF  (KIPF.NE. IPF)  GO  TO  625 
KIPF  - 0 
580  SUMCI  - 0.0 

DO  590  I SUM  - 3 , IMAXP2 
IF  (VAR(ISUM) .LT.O.O)  NEG  - -1 
IF  (VAR(ISUM) .LT.O.O)  WRITE(*,585) 

585  FORMAT ( 5X , ' NEGATIVE  Cl '/) 

590  SUMCI  - SUMCI  + VAR(ISUM) 


DO  595  I CM  - l.IMAX 
595  CM(ICM)  - VAR(ICM+2)*MU/MUI(ICM) 

C PRINT  ANSWERS 

WRITE(8f  600)  IPSI,  IX,  IQ3, MODEL, XVAR.H. MU, PFTL,RHO,U,T,E,  SPEC,  SUMCI 
WRITE(* , 600)  IPSI,  IX,  IQ3,  MODEL,  XVAR.H,  MU,  PFTL,RHO(U,T(E,  SPEC,  SUMCI 
600  FORMAT  (IX,' PS  I - ',I4,3X,'IX  - ' ,14, 8X, 'SHOCK  J COND.  - \I2.14X, 

*'  CVD  MODEL  - ',12,/  ,1X,'X  - \D9.4,2X,'H  - ' , D9 . 4 , 2X , 'MU  - ', 

*E9 .4 , 2X, ' P - ' , E9 .4 , 3X, 'RHO  - '.E9.4,/  ,1X,'U  - ',E9.4,2X,'T  - ', 
*E9.4,2X,'E  - ' .E9.4.2X, 'CIT  - ' ,E9.4,2X, 'SUMCI  - '.E9.4  ) 

DO  603  I - 3 , IMAXP2 
J - I - 2 

WRITE(*, 605)  J ,VAR(I) , J , CM(J) , J , VAR(IMAX+I) 

603  WRITE(8 , 605)  J , VAR(I) , J , CM(J) , J ,VAR(IMAX+I) 

605  FORMAT(6X, 'CI(',I2, ')  - ' , Dll . 4 ,4X, ' CM( ' , 12 , ' ) - \E11.4,4X, 

* 'EVI(' ,12, ')  - ' .D11.4) 

C WRITE(* , 620) 

WRITE(8 , 620) 

620  FORMAT (/) 

DO  621  I - 1 , IMAX 
IF  (EVI(I) .EQ.0.0)  TVI(I)  - 0.0 
IF  (I.EQ.IMAX)  THEN 
WRITE(*, 623)  I , TVI ( I ) , TE1 , ITRTE , W1 
WRITE(8 , 623)  I , TVI (I) , TE1 , ITRTE, W1 
GO  TO  621 
END  IF 

WRITE(*, 622)  I ,TVI(I) 

WRITE(8 , 622)  I,TVI(I) 

621  CONTINUE 

622  FORMAT(5X, 'TVI(' ,12, ')  - '.Ell. 4) 

623  FORMAT(5X, 'TVI(' ,12, ')  - ' , Ell. 4, IX, 'TE1-  ', Ell. 4, IX, 

* 'ITRTE-  ' ,12, IX, 'W1-' ,E10.3) 

C WRITE(*, 620) 

WRITE(8 , 620) 

625  IF  (NEG.EQ.-l)  WRITE(*,630) 

630  FORMAT (IX,  ' A NEGATIVE  CONCENTRATION  , Cl  IN  MAIN  : STOP  670'/) 

IF  (NEG.EQ. -1)  STOP 

c STOP  670 

C WHEN  IPSI  - (NSR+1) , DELX  AND  STAGNATION  STREAMLINES  WILL  BE  COMPUTED 
C IUNEG  - 1 IF  U**2  NEG.  IN  BASIC 

IF  (IUNEG. EQ.l)  GO  TO  735 

IF  ( (IPSI. LT. (NSR+1)) .AND. (VAR(l) .LT.XPST(l) ) ) GO  TO  505 
IF  ((ISTAG.EQ.l) .OR. ( ISTAG . EQ . 2) ) GO  TO  690 
C ISTAG  - 0 UNTIL  AFTER  EXTRAPOLATION  FOR  PSI  - 0.0  STREAMLINE 

C ISTAG  - 1 FOR  PSI  - 0.0  STREAMLINE 

C ISTAG  - 2 FOR  DELX  STREAMLINE  AND  THEREAFTER 

635  IG  - IG+1 
IGC  - 0 

IGE  - IMAX  + 2 
PSIG(IG)  - PSIS 
DO  640  IG1  - 3 , IMAXP2 
IGC  - IGC  + 1 
CIG(IGC.IG)  - VAR(IGl) 

IGE  - IGE  + 1 
EIG(IGC , IG)  - VAR(IGE) 

640  CONTINUE 
EG(IG)  - E 
TG(IG)  T 
HG(IG)  - H 

IF  (IPSI. LT. (NSR+1))  WRITE(8 , 725) 

IF  (IPSI. LT.  (NSR+1))  WRITER, 725) 


o o 


IF  ( IPSI. LT. (NSR+1))  GO  TO  730 

IPSI  - (NSR+1)  IS  THE  STAGNATION  STREAMLINE  ; 
AT  DELX  .EXTRAPOLATE  FOR  PS I - 0.0  VALUES 

PSI  - 0.0 
MG  - 1 

CALL  FTLUP  (PSI . E,MG , IG. PSIG , EG) 

CALL  FTLUP  (PSI ,T,MG , IG , PSIG ,TG) 

CALL  FTLUP  (PSI ,H,MG , IG , PSIG ,HG) 

DO  650  IG2  - l.IMAX 
DO  645  IG1  - 1.NSR1 
CIT(IGl)  - CIG(IG2 , IG1) 

645  EIT(IGl)  - EIG(IG2 , IG1) 

CALL  FTLUP  (PSI ,CI(IG2) ,MG, IG.PSIG.CIT) 

IF  (CI(IC2) .LT.0.0)  CI(IG2)  - 1.0E-08 
CALL  FTLUP  (PSI , EVI (IG2) ,MG , IG , PSIG , EIT) 

650  VAR(2+IMAX+IG2)  - EVI(IG2) 

C INITIALIZE  FOR  PSI  - 0.0  STREAMLINE 

CJ  - XI 
SPEC  - 0.0 
II  - 0 
KEYINT  - 0 
IX  - 0 
SUM  - 0.0 
DO  660  I - l.IMAX 
SUM  - SUM  + Cl (I)/MUI (I) 

IF  (EVI (I) .EQ.0.0)  TVI(I)  - 0.0 
IF  (EVI (I) .EQ.0.0)  GO  TO  660 

XL  - ( ( DGENI ( I ) *R*THETAI (I))/(MUI(I) *EVI ( I ) ) + 1.0) 

ALN  - DLOG(XL) 

TVI(I)  - THETAI ( I ) /ALN 
660  CONTINUE 

MU  - 1.0/SUM 

U - DSQRT(2 . 0*(HSTAG  - H)) 

VAR(l)  - DELX 

C COMPUTE  P AND  DPDX  AT  IPSI  - (NSR+1)  ( AT  THE  BODY  ) 

IF  (IANS.EQ.O)  WRITE(8 , 665) 

IF  ( (IPSI . EQ. IS1) . OR. (IPSI.EQ.IS2) .OR. (IPSI . EQ . IS3) ) WRITE(8,665) 

IF  ( (IPSI . EQ. IS4) .OR. (IPSI.EQ.IS5) .OR. (IPSI . EQ. IS6) ) WRITE(8,665) 

IF  (IANS.EQ.O)  WRITE(*, 665) 

IF  ( (IPSI . EQ. IS1) .OR. (IPSI.EQ.IS2) .OR. (IPSI . EQ. IS3) ) WRITE(*,665) 

IF  ( (IPSI . EQ. IS4) .OR. (IPSI.EQ.IS5) .OR. (IPSI . EQ. IS6) ) WRITE(*,665) 

665  FORMAT ( IX , ' - - PSI  - 0.000  STREAMLINE 

P(NSR+1)  - PS  + US/(RCM(NSR+1)*RSM(NSR+1) )*( -PSIS) 

RHO  - P(NSR+1)/(H  - E) 

NSR2  - NSR  + 2 
DO  670  I - NSR2 , IZTERM 
READ(10 ,*)  IXT , TS , ES , PS ,RHOS ,US , PSIS ,HS 
670  P(I)  - PS  + US/(RCM(I)*RSM(I) )*( - PSIS) 

CLOSE(IO) 

CLOSE (11) 

DPDX (NSR+1)  - (-3.*P(NSRl)+4.*P(NSR2)-P(NSR+3))/(2.*DELX) 

C EVALUATE  DPDX  FROM  (NSR+2)  TO  IZTERM 

DO  680  I - NSR2, IZTERM 
IF  ( I. LT. IZTERM)  THEN 
DPDX(I)  - (-  P(I-l)  + P(I+1) )/(2 . *DELX) 

ELSE 

DPDX ( I ) - (P(I-2)  - 4.*P(I-1)  + 3.*P(I))/(2. *DELX) 

ENDIF 

680  CONTINUE 

OPEN  (UNIT=10,FILE=' STAG. DAT' , STATUS-' OLD ' ) 
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OPEN  (UNIT-11  .FILE- 'EVISC.DAT'  .STATUS- 'OLD') 

DO  685  I - l.NSR 

READ(10,*)  IX.TS.ES, PS, RHOS, US, PSIS.HS 
685  READ(11,*)  (EVIS(J).J  - l.IMAX) 

ISTAG  - 1 
PSIS  - 0.0 
GO  TO  500 

C AT  EACH  X WHERE  PHYSICAL  SPACE  CALCULATIONS  ARE  DESIRED  SAVE 

C l./(RHO*U)  ON  EACH  STREAMLINE 

690  IF  (XPST(LPS2) . EQ.XPST(l) ) ICNT  - IPSI 
JJJ  - IPSI  - ICNT  + 1 
IF  (VAR(l) .LT.XPST(LPS2) ) GO  TO  720 
IF  (VAR(l) .GT.XPST(LPS2))  GO  TO  705 

C VAR(l)  - XPST(LPS2) 

RHOURT  - 1 . 0/(RHO*U) 

TEMP  - TV I ( 1) 

TEMPO  - T 
RCON1  - VAR(3) 

RCON2  - VAR (4) 

RC0N3  - VAR(5) 

RCON4  - VAR(6) 

RCON5  - VAR(7) 

RCON6  - VAR(8) 

RCON7  - VAR(9) 

IF  (IMAX.EQ.10)  THEN 
RC0N8  - VAR(IO) 

RCON9  - VAR(ll) 

RCONIO  - VAR(12) 

ENDIF 

RRHO  - RHO 

WRITE (14,*)  IPSI, RHOURT, VAR(l) .PSIS 
WRITE(16 ,*)  LPS2.JJJ 

IF  (IMAX.EQ.7)  WRITE (16,*)  RCON1 , RCON2 , RCON3 , RC0N4 , RCON5 , 

* RCON6.RCON7, RRHO, TEMP, TEMPO 

IF  (IMAX.EQ.10)  WRITE(16 , *)  RCON1 , RCON2 , RCON3 , RC0N4 , RCON5 , RCON6 

* , RCON7 , RCON8 , RCON9 , RCONIO , RRHO , TEMP , TEMPO 
GO  TO  715 

705  YPSIS  - PREPSI  + (XPST(LPS2)  - PREX)*((PSIS  - PREPSI)/ 

* (VAR(l)  - PREX)) 

RHOURT  - PRERU  + (XPST(LPS2)  - PREX)*( (RHO*U  - PRERU)/ 

* (VAR(l)  - PREX)) 

TEMP  - PRETEP  + (XPST(LPS2)  - PREX)*( (TVI(l)  - PRETEP)/ 

* (VAR(l)  - PREX)) 

TEMPO  - PRET  + (XPST (LPS2)  - PRET)*((T  - PRET)/ 

* (VAR(l)  - PRET)) 

RCONl  - PREC1  + (XPST(LPS2)  - PREX)*( (VAR(3)  - PREC1)/ 

* (VAR(l)  - PREX)) 

RCON2  - PREC2  + (XPST(LPS2)  - PREX) *( (VAR (4)  - PREC2)/ 

* (VAR(l)  - PREX)) 

RCON3  - PREC3  + (XPST(LPS2)  - PREX)*( (VAR(5)  - PREC3)/ 

* (VAR(l)  - PREX)) 

RCON4  - PREC4  + (XPST(LPS2)  - PREX)*( (VAR(6)  - PREC4) / 

* (VAR(l)  - PREX)) 

RCON5  - PREC5  + (XPST(LPS2)  - PREX)*( (VAR(7)  - PREC5)/ 

* (VAR(l)  - PREX)) 

RCON6  - PREC6  + (XPST(LPS2)  - PREX)*( (VAR(8)  - PREC6) / 

* (VAR(l)  - PREX)) 

RCON7  - PREC7  + (XPST(LPS2)  - PREX)*( (VAR(9)  - PREC7) / 

* (VAR(l)  - PREX)) 

IF  (IMAX.EQ.10)  THEN 


RC0N8  - PREC8  + (XPST(LPS2)  - PREX) *( (VAR (10)  - PREC8 ) / 

* (VAR(l)  - PREX)) 

RCON9  - PREC9  + (XPST(LPS2)  - PREX) *( (VAR (11)  - PREC9 ) / 

* (VAR(l)  - PREX)) 

RCONIO  - PREC10  + (XPST(LPS2)  - PREX)*( (VAR(12)  - PRECIO)/ 

* (VAR(l)  - PREX)) 

ENDIF 

RRHO  - PRERHO  + (XPST(LPS2)  - PREX)*((RHO  - PRERHO)/ 

* (VAR(l)  - PREX)) 

RHOURT  - 1 . O/RHOURT 

WRITE(14 ,*)  IPSI, RHOURT, XPST(LPS2) .YPSIS 
WRIT£(16 ,*)  LPS2.JJJ 

IF  (IMAX.EQ. 7)  WRITE(16 ,*)  RCON1 , RCON2 , RCON3 , RCON4 , RCON5 , 

* RCON6.RCON7, RRHO, TEMP, TEMPO 

IF  (IMAX.EQ. 10)  WRITE (16,*)  RCON1 ,RCON2 ,RCON3 ,RC0N4 ,RCON5 ,RCON6 

* , RCON7 , RCON8 , RCON9 , RCONIO , RRHO , TEMP , TEMPO 
715  LPS2  - LPS2  + 1 

KSTAG  - KSTAG  + 1 
720  PREX  - VAR(l) 

PRERU  - RHO*U 
PREPSI  - PSIS 
PRETEP  - TVI(l) 

PRET  - T 
PREC1  - VAR(3) 

PREC2  - VAR(4) 

PREC3  - VAR(5) 

PREC4  - VAR(6) 

PREC5  - VAR(7) 

PREC6  - VAR(8) 

PREC7  - VAR(9) 

IF  (IMAX.EQ. 10)  THEN 
PREC8  - VAR(IO) 

PREC9  - VAR (11) 

PRECIO  - VAR(12) 

ENDIF 

PRERHO  - RHO 

IF  (VAR(l) .LT.VARI(IZTERM) ) GO  TO  505 
C END  OF  STREAMLINE 

WRITE(* , 725) 

WRITE(8 ,725) 

725  FORMAT ( IX, 'XXXXXXXXXXXXXXXX'/) 

IF  ((IPSI. EQ. (NSR+1)) .AND. (ISTAG.EQ.l))  GO  TO  425 
730  GO  TO  420 

C COMPUTE  PHYSICAL  SPACE  VALUES 

735  WRITE (15,*)  KSTAG 
CLOSE(IO) 

CLOSE(ll) 

CLOSE(12) 

CLOSE(13) 

CLOSE(15) 

CLOSE(16) 

WRITE (* , 740)  KSTAG 
WRITE (8, 740)  KSTAG 

740  FORMAT (IX, 'BEGIN  PHYSICAL  SPACE  CALCULATIONS  KSTAG  = ',15/) 

OPEN (UNIT-17 , FILE- ' RADIN3 . DAT ' , STATUS- ' UNKNOWN ' ) 

C 

LPS3  - 0 

DO  840  LPS  - l.NXPST 
CLOSE (14) 

OPEN  (UNIT-14 , FILE- ' RHORT . DAT ' , STATUS- ' OLD ' ) 
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IK  - 0 

745  LPS3  - LPS3  + 1 

IF  (LPS3.GT.IZTERM)  GO  TO  840 

IF  (DABS(X1(LPS3)  - XPST(LPS))  .GT.1.0E-08)  GO  TO  745 

DO  780  IPS  - l.KSTAG 

READ (14,*)  IPSI ,RHOURT,VAR(l) ,PSIS 

VARHX  - VAR(l)  - XPST(LPS) 

IF  (DABS(VARMX) .GT.1.0E-08)  GO  TO  780 
IK  - IK  + 1 
IBOB  - IK  - 1 

IF  (IK.GT.200)  WRITE(* , 770)  IK 

770  FORMAT  (IX, 'IK.GT.200,  CHANGE  DIMENSION  OF  RUT  AND  PSISTG.IK  - ',13) 

RUT (IK)  - RHOURT 
PSISTG(IK)  - PSIS 
780  CONTINUE 

C FIND  SMALLEST  DELTA  PS I 

SMALL  - 200.0 
DO  785  I - 2, IK 

IF  ( (PSISTG(I)  - PSISTG(I-l)) .LT. SMALL)  SMALL  - PSISTG(I) 

* - PSISTG(I-l) 

785  CONTINUE 

XDEL  - PSISTG(IK)/SMALL 

C TRUNCATE 

L - INT(XDEL  +1.0) 

C REMAINDERING  M - 0 FOR  EVEN,  M - 1 FOR  ODD 

M - MOD(L, 2) 

C MAKE  L EVEN 

IF  (M.NE.O)  L - L + 1 

FIND  INTEGRAL  l./(RH0*U)  DELTA  PSI  FROM  BODY  TO  SHOCK 
USING  SIMPSONS  RULE  ; L INCREMENTS  , L+l  POINTS 

FL  - L 

DPSIS  - PSISTG(IK)/FL 
PSII  - 0.0 

RB  - RUT ( 1 ) + RUT (IK) 

DO  800  I - 2 , L,  2 
PSII  - PSII  + DPSIS 

CALL  FTLUP  (PSII ,RU1 , 1 , IK.PSISTG.RUT) 

IF  (I.EQ.L)  RB  - RB  + 4.0+RU1 
IF  (I.EQ.L)  GO  TO  800 
PSII  - PSII  + DPSIS 

CALL  FTLUP  (PSII , RU2 , 1 , IK, PSISTG .RUT) 

RB  - RB  + 4.0+RU1  + 2 . 0*RU2 
800  CONTINUE 

RB  - RB+DPSIS/3 . 0 

ARR  - DSQRT(RSM(LPS3)**2  - 2 . 0*C0STM(LPS3)*RB) 

YI  - (RSM(LPS3)  - ARR) /COSTM(LPS3) 

WRITE(17 ,*)  IBOB, IK 
WRITE(17 , *)  YI 

ZE  - ZSM(LPS3)  + YI*SINTM(LPS3) 

WRITE(* ,815)  PSISTG(l) ,X1(LPS3) ,ARR,YI,ZE 
WRITE(8 , 815)  PSISTG(l) ,X1(LPS3) ,ARR,YI,ZE 
815  FORMAT ( IX , 'PSI  - ' ,E12.5,/,1X, 'X  - ' ,E13.6,3X, 'R  - ' .E13.6 

* ,3X, 'Y  - ' .E13.6.3X, 'Z  - ' ,E13.6/) 

DO  830  I - 2, IK 
DPSI  - PSISTG(I)  - PSISTG(I-l) 

C TRAPEZOIDAL  RULE 

TR  - (DPS 1/2 . 0)*(RUT(I)  + RUT(I-l)) 

RB  - RB  - TR 

ARR  - DSQRT(RSM(LPS3)**2  - 2 . 0*COSTM(LPS3)*RB) 

YI  - (RSM(LPS3)  - ARR) /COSTM(LPS3) 
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WRITE(17 ,*)  YI 

ZE  - ZSM(LPS3)  + YI*SINTM(LPS3) 

WRITE(8 , 815)  PSISTG(I) ,X1(LPS3) ,ARR,YI,ZE 
WRITE(*, 815)  PSISTG(I) ,X1(LPS3) ,ARR,YI,ZE 
830  CONTINUE 

WRITE(8 , 835) 

WRITE(*, 835) 

835  FORMAT (//) 

840  CONTINUE 
845  WRITE(8 , 850) 

WRITE(*, 850) 

850  FORMAT (IX, 'END  THIS  CASE  , HALLELUJAH  '/) 
CLOSE(8) 

CLOSE(14) 

CLOSE(17) 

STOP 

END 


SUBROUTINE  BASIC 

BASIC  CALLED  BY  CALINTH  TO  EVALUATE  DERIVATIVES  H DOT, 

C C SUB  I DOT  AND  EV  SUB  I DOT  ; DERIVATIVES  START  IN  DER(l) 

C 

IMPLICIT  REAL*8(A-H,0-Z) 

COMMON  /Al/  M, IX, IMAX, IPSI , MODEL, TE1.TE2 
COMMON  /A2/  P(200) ,DPDX(200) ,VARI(200) 

COMMON  /A3/  EVIINF(25) ,THETAI(25) ,MUI(25) ,FI(25) ,DELHI(25) , 

* CIINF(25) ,LI(25) 

COMMON  /A4/  R.MUINF, DELTA, LAMSQ , OMEGSQ , OMEGA, MU, T,U,TINF 
COMMON  /A5/  EPSIIL(20,25) ,GIL(20,25) ,CID(200,4) 

COMMON  /A6/  VAR(52) ,CUVAR(52) ,DER(51) 

COMMON  /A7/  MJ(50),EJ(50),AJ(50),BJ(50) .DIRECT (50) 

COMMON  /A8/  TVI(25) ,NI(25) ,DGENI(25) ,BI(25) 

COMMON  /A10/  NUIJ (26,50) , AIJ(25 ,50) ,NUPIJ (25 ,50) 

COMMON  /All/  SIGIK(25 ,25) , ALPIK(25 , 25) , BETAIK(25 ,25) 

COMMON  /A13/  DELX, ZSTERM , IZTERM, NSR.MW, SP , TS 

COMMON  /A14/  EINF , PINF , RHOINF , VINF , E , JMAX , KEYINT , RHO , HSTAG 

COMMON  /A15/  PFTL,KITR1,NIP(25) ,UP(25) 

COMMON  /A16/  IUNEG,WE(25) ,WEXE(25) ,WEYE(25) ,WEZE(25) 

COMMON  /A20/  WE1.WE2 
COMMON  /A18/  ITNEG , I EXP 

DIMENSION  PHI (50) , SJ (50) , DCIJDX(50) , EVP (100) 

DIMENSION  CI(25) ,EVI(25) ,DCIDX(25) ,DEVIDX(25) ,EVIBAR(25) 
EQUIVALENCE  ( CUVAR (2) ,H) , ( CUVAR ( 3 ) , Cl ( 1 ) ) 

EQUIVALENCE  (DER(l) , DHDX) , (DER(2) ,DCIDX(1)) 

REAL*8  KPJ ,KEQ,KJ (50) , LAMSQ, MU, MUI ,MUIOT,MUINF,ND 
C 

C DER(l)  - DHDX  MUST  BE  DHDX  AS  H MAY  BE  + OR  - 

C DER(2)  - DCIDX(l) 

C 

C DER(1+IMAX)  - DCIDX(IMAX) 

C DER(1+IMAX+1)  - DEVIDX(l) 

C DER ( 1+IMAX+IMAX)  - DEVIDX(IMAX) 

C 

C CUVAR(l)  - X 

C CUVAR(2)  - H, ENTHALPY  - IT  MUST  BE  H WHICH  MAY  BE  + OR  - 

C CUVAR(3)  - CI(1) 

C 
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CUVAR ( 2+IMAX)  - CI(IMAX) 

CUVAR(2+IMAX+1)  - EVI(l) 
CUVAR(2+IMAX+IMAX)  - EVI(IMAX) 


KEYINT  - 1 AT  END  OF  1ST  INTERVAL 
IF  ( ITNEG . EQ . 1 . OR . IEXP . EQ . 1 ) RETURN 
IF  (M.NE.O)  GO  TO  10 
DO  5 I - 1 , IMAX 
J1  - I + IMAX  + 2 
5 CUVAR(Jl)  - VAR(Jl) 

C INTERPOLATE  FOR  P ACROSS  INTEGRATION  INTERVAL 

10  DO  15  I - 1 , IMAX 
15  EVI(I)  - CUVAR ( 2+IMAX+I ) 

MFTL  - 1 

NFTL  - IZTERM  - IPSI  + 1 

CALL  FTLUP  (CUVAR(l)  , PFTL, MFTL, NFTL, VARI  (IPSI)  , P(IPSI)  ) 

C INTERPOLATE  FOR  DPDX 

CALL  FTLUP  (CUVAR(l)  .DPFTL, MFTL, NFTL, VARI(IPSI)  .DPDX(IPSI)) 

IF  (KEYINT. EQ.O)  GO  TO  95 

SUM  - 0.0 

DO  45  I - 1 , IMAX 

C USE  SHOCK  VALUES  FOR  INITIAL  COMPUTATION  ON  EACH  STREAMLINE 

SUM  - SUM  + CI(I)/MUI(I) 

IF  (EVI(I) .EQ.0.0)  TVI(I)  - 0.0 
IF  (EVI(I) .EQ.0.0)  GO  TO  45 

XL  - ( ( DGENI ( I ) *R*THETAI ( I ) ) / (MUI ( I ) *EVI ( I ) ) + 1.0) 

ALN  - D LOG (XL) 

C COMPUTE  TVI 

TVI(I)  - THETAI(I)/ALN 
45  CONTINUE 
MU  - 1.0/SUM 
U2  - 2 . 0*(HSTAG  - H) 

IF  (U2.LT.0.0)  WRITE(*,50)  H 
50  FORMAT ( IX, 'U**2  IS  NEG  IN  BASIC  , H - ' .E11.4.2X, 

* 'END  STREAMLINE  INTEGRATION') 

IF  (U2.LT.0.0)  IUNEG  - 1 
IF  (U2.LT.0.0)  RETURN 
U - DSQRT(U2) 

C ITERATE  FOR  E 

KCODE  - 0 
55  KITR1  - 0 
ICODE  - 0 
MAXI  - 50 
TOL1  - .001 
TOL2  - .00001 
C 

CALL  FOFE  (MAXI , TOL1 , TOL2 , ICODE, E) 

C 

IF  (ICODE. EQ.O)  GO  TO  75 
IF  (ICODE. EQ.l)  WRITE(*,60) 

60  FORMAT (IX, '*  MAXIMUM  ITERATION  EXCEEDED  IN  SUB  BASIC  *:  STOP  66'/) 

IF  (ICODE. EQ. 2)  WRITE(*,65) 

65  FORMAT ( IX, '***  DERIVATIVE  - 0 IN  SUB  BASIC  ****  : STOP  66'/) 

WRITE(* , 70)  ICODE 

70  FORMAT (IX, 'ICODE  - ',12,'  IN  SUB  BASIC  '/) 

IF  (ICODE. NE.l)  STOP 
IF  (KCODE. EQ. 3)  STOP 

: WHEN  ICODE  - 1,  TRY  A NEW  STARTING  E.  DO  THIS  2 TIMES  ; STOP  66 

KCODE  - KCODE  + 1 
GO  TO  55 
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75  IF  (IEXP.NE.l)  GO  TO  85 
KCODE  - KCODE  + 1 
I EXP  - 0 

IF  (KCODE. EQ.l)  GO  TO  55 
IF  (KCODE. GT. 2)  RETURN 
E - H • H*l.E-05 
GO  TO  55 

85  RHO  - PFTL/ (H  - E) 

T - (PFTL*MU)/(RHO*R) 

IF  (T.GT.0.0)  GO  TO  95 
WRITE(*, 90)  T,RHO,PFTL,H,E,MU 

90  FORMAT (IX, 'T  NEGATIVE  - ' ,E12.4,1X, 'RHO  - Ell. 4, IX, 'PFTL  - ', 

* Ell. 4,/, IX, 'H  - '.Ell. 4, IX, 'E  - ', Ell. 4, IX, 'MU  - '.E11.4.2X, 

* 'IN  SUB  BASIC'/) 

E - H - H*1.0E-06 
ITNEG  - 1 

RETURN 

95  KEYINT  - 1 

PI  - 4 . 0*ATAN(1.0) 

BC  - 1 . 38054E-16 
AVGN  - 6 . 02252E+23 
575  IF  (IX. EQ.l)  THEN 
TE  - TINF 
TE1  - TE 
TE2  - TE 
END  IF 

C ELECTRON  TEMPERATURE  MODEL 

C ELECTRON  TEMPERATURE  MODEL 

C IF  (IX. EQ.l)  GO  TO  576 

C CORR  - 4.23E-06*(T**(-2.88)) 

C CN  - RH0*6 . 02252E+23 

C CNN  - CN*VAR(5)/MUI(3) 

C CNO  - CN*VAR(6)/MUI (4) 

C TE  - DLOG ( 1 . + 10. l/( (CNO+CNN)*CORR) ) 

C TE  - T/(l.  + TE*T/85000 . ) 

C ITRTE-0 

C FNA-CN*CI (3)  /MUI ( 3 ) 

C FNI-CN*CI (9)  /MUI (9) 

C FNE-CN*CI(7)  /MUI (7) 

C IF  (FNE. LT . 1 . 0D04)GO  TO  576 

C FNM-CN*CI (1)  /MUI ( 1 ) 

C EI-2 . 3322D-11 

C FAV-6 . 023D23 

C SA-1.52D-15 

C Fl-0 

C F2-0 

C FO-O 

C 574  ITRTE-ITRTE+1 
C IF(ITRTE.GT. l)GO  TO  571 

KK-0 

569  KK-KK+1 

IF(KK. GT. 100)GO  TO  576 
TE-1000*KK 

571  SM-0 . 5355D-19*TE+. 696D-15 
IF(ITRTE.GT. 100)GO  TO  573 
SI-1. 53614D08*(TE**3) /FNE 
C SI-DSQRT(SI) 

C SI=(4.38384D-06/(TE**2))*DLOG(SI) 

C FKF-1 . 1D32*(TE**( - 3 . 14D0) )*DEXP( -1 . 69D05/TE) 

C FKB-2 . 2D20*(TE**( -4 . 5D00) )*1 . D20 
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C UEA-FKF*FNA - FKB*FNE* ( FNI/FAV) 

C WEA— WEA*U*FAV/CI ( 7 ) 

C SX-FNA*SA+FNI*S I+FNM/2 . ODO*SM 

C W1-DCIDX(7)*U*FAV/CI(7) 

C WRITE(*, 577)KK, ITRTE.Wl ,WEA, FE 

C 577  FORMAT ( 215, 2E11. 3, F10.0) 

C Wl-WEA 

C FE-T-1 . 23357D-10/SX/DSQRT(TE)*(WEA*EI+VJ1*3 ,45D-16*TE)  -TE 

C IF(ITRTE.GT. l)GO  TO  568 

C IF( (FE/DABS (FE)*F0) ,LT.O.DOO)GO  TO  567 

C FO-FE 

C TO-TE 

C GO  TO  569 

C 567  Fl-FE 
C Tl-TE 

C 566  TE-(TO*F1-T1*FO)/(F1-FO) 

C IF  (DABS(TE-Tl) ,LT.1.DOO)GO  TO  573 

C IF(DABS (TE-TO) .LT.1.DOO)GO  TO  573 

C GO  TO  574 

C 568  IF((FE*FO) . LT . 0 . ODOO)GO  TO  564 

C TO-TE 

C FO-FE 

C GO  TO  566 

C 564  Fl-FE 

C Tl-TE 

C GO  TO  566 

C573  CONTINUE 

C 573  IF  (TE.GT.T)TE-T 

C TE1  - TE 

C IF  (ITRTE . GT. 100) WRITE (* , 572) 

C 572  FORMAT ( ' ',’TE  DID  NOT  CONVERGE') 

C CN2  - RHO*6 . 02252E+23*VAR(3) /MUI(l) 

C A - DLOG(l . 01D+01)  - DLOG(CN2)  - DLOG(6 . 4D+00) 

C * - 59.*DLOG(1.0D+01)  + 19 . *DLOG(TVI (1) ) 

C A - DEXP(A) 

C TE  - DLOG ( 1 . + A) 

C TE  - TVI (1)/(1 . + TE*TVI(l)/85000.) 

C TE2  - TE 

576  CONTINUE 

C 

C COMPUTE  DCIDX  AND  DEVIDX  FOR  EACH  SPECIE  I 

DO  210  I - l.IMAX 
DCIDX(I)  - 0.0 
CVSUM1  - 0.0 
CVSUM2  - 0.0 

C CORRECTED  RELAXATION  TIME  FOR  PARK  MODEL 

IF  (M0DEL.EQ.4.AND.I.EQ.1)  THEN 
ND  - RHO*AVGN*CI ( I ) /MUI ( I ) 

SIGMAV  - 1. 00E - 17* ( 50000. /T)**2 
C - DSQRT(8.*AVGN*BC*T/(PI*MUI(I))) 

TAUC  - 1 . 0/ (C*SIGMAV*ND) 

END  IF 

- FOR  EACH  REACTION  J 

DO  190  J - l.JMAX 
ICT  - MOD(J , 2) 

: II  IS  THE  SELECTED  SPECIE  FOR  REACTION  J 

KNT  - 0 

IF  (ICT.EQ.l)  THEN 
IF  ( DIRECT ( J ) . EQ . 1 . 0 ) PHIC  - 1.0 
IF  (DIRECT (J) . EQ. 2 . 0)  PHIC  - 2.0 


_ SPJ. 


II  - MJ(J) 

100  IF  (M.EQ.O)  GO  TO  115 

IF  (FI(II).NE.O.O)  GO  TO  120 
115  IF  (PHIC.EQ.1.0)  PHI(J)  - 1.0 
IF  (PHIC.EQ.2.0)  PHI(J+1)  - 1.0 
GO  TO  125 

120  IF  (MODEL. EQ. 3. AND. UP (II) .NE;0.0)  GO  TO  122 
‘ TEM  - DEXP(THETAI(II)/TVI(II) ) 

TEM1  - DEXP (THETAI ( I I ) /T ) 

TEM2  - DEXP (-NI(II) * (THETAI (II) /TVI (II)  - THETAI ( II )/T) ) 

TEM3  - DEXP(THETAI(II)/TVI(II)  - THETAI(II)/T) 

IF  (TEM3.EQ. 1.0. AND. PHIC.EQ.1.0)  PHI(J)  - 1.0 
IF  (TEM3.EQ. 1.0. AND. PHIC.EQ.2.0)  PHI(J+1)  - 1.0 
IF  (TEM3.EQ.1.0)  GO  TO  125 

C PHI  - COUPLING  COEFF.  ; FOR  CVD.CVDV  AND  PARK  MODEL 

IF  (PHIC.EQ.1.0)  PHI(J)  - ((1.0-TEM2)/(TEM3-1.0)*(TEM  - 1.0) 

* /(TEM1  - 1.0))/NI(II) 

IF  (PHIC.EQ.2.0)  PHI (J+l)  - ( (1.0-TEM2)/(TEM3-1.0)*(TEM  - 1.0) 

* /(TEM1  - 1.0)) /NI (II) 

GO  TO  125 

122  USUM  - 0.0 
TSUM  - 0.0 
TFSUM  - 0.0 
TVTSUM  - 0.0 

TF  - 1. 0/(1. /TVI (II)  - l./T  - l./UP(II)) 

NIC  - NIP(II)  + 1 
DO  123  N - l.NIC 
XN  - N 

EEVP  - XN  - 0.5 

EVP(N)  - EEVP*(WE(II)  + EEVP*( -WEXE(II)  + EEVP*(WEYE(II)  + 

* WEZE(II)*EEVP) ) ) 

EVP(N)  - EVP(N)  - EVP(l) 

USUM  - USUM  + DEXP (EVP (N) /UP (II) ) 

TSUM  - TSUM  + DEXP ( -EVP (N) /T) 

TFSUM  - TFSUM  + DEXP ( -EVP (N)/TF) 

123  TVTSUM  - TVTSUM  + DEXP(-EVP(N)/TVI(II)) 

C COUPLING  COEFF.  FOR  CVDV- PREFERENTIAL  MODEL 

IF  (PHIC.EQ.1.0)  PHI ( J ) - (TSUM*TFSUM)/(USUM*TVTSUM) 

IF  (PHIC.EQ.2.0)  PHI (J+l)  - (TSUM*TFSUM)/(USUM*TVTSUM) 

125  KNT  - KNT  + 1 

IF  (KNT. EQ.l. AND. PHIC.EQ.1.0)  THEN 
PHIC  - 2.0 
II  - MJ (J+l) 

GO  TO  100 
ENDIF 

IF  (KNT. EQ.l. AND. PHIC.EQ.2.0)  THEN 
PHIC  - 1.0 
II  - MJ (J+l) 

GO  TO  100 
ENDIF 

C START  OF  LOOP  TO  DETERMINE  EQUILIBRIUM  CONSTANT 

BETAJ  - 0.0 
FJORT  - 0.0 
DO  130  K - l.IMAX 
SUMG  =0.0 
LI  I = LI  (K) 

DO  128  L = l.LII 

128  SUMG  = SUMG  + GIL(L, K)*DEXP( -EPSIIL(L,K)/T) 

Z MUIOT  = (CHEMICAL  POTENTIAL)/! 

MUIOT  - - (BI(K)  + (5.  + 2.*FI(K))/2.*(DLOG(TINF)  + 


sJ* 


* DLOG(T/TINF) ) + FI(K)*DL0G(1./(1.  - DEXP( -THETAI (K)/T) ) ) 

* + DL0G(SUMG/GIL(1  ,K)  ) ) + DELHI (K)/(R*T) 

BETAJ  - BETAJ  + (NUPIJ(K.J)  - NUIJ(K,J)) 

130  FJORT  - FJORT  + (NUPIJ(K.J)  - NUIJ (K, J) )*MUIOT 

KPJ  - EQUIL.  CONST.  (IN  TERMS  OF  PARTIAL  PRESSURES) 

KPJ  - DEXP( -FJORT) 

KEQ  - EQUILIBRIUM  CONSTANT 

KEQ  - KPJ*(9 . 8688225E-07*R*T)**( -BETAJ) 

KJ  - RATE  CONSTANT  (FORW:  J - 1,3,.  BACK:  J - 2. A,.) 
IF  (DIRECT (J) . EQ. 1 . 0)  THEN 
KJ (J)  - AJ (J)*T**BJ (J)*DEXP(-EJ (J)/T) 

IF  (J.EQ.19)  KJ (J)  - AJ (J)*TE1  **BJ (J)*DEXP( -EJ (J)/TE1  ) 

IF  (J.EQ.21)  KJ (J)  - AJ (J)*TE1  **BJ(J)*DEXP(-EJ(J)/TE1  ) 

IF  (TE1 . LT. 2 . D3)GO  TO  131 

IF(J . EQ . 19)  KEQ-(1.8D-08)*(TE1**1.5D0)*DEXP(-1.69D5/TE1) 

IF(J . EQ. 21)  KEQ- (3 . 59D-09)*(TE1**1 . 5D0)*DEXP( - 1 . 575D5/TE1) 

131  KJ (J+l)  - KJ (J)/KEQ 
ELSE 

KJ (J+l)  - AJ (J)*T**BJ (J)*DEXP( -EJ (J)/T) 

IF  (J.EQ.19)  KJ (J+l)  - AJ (J)*TE1  **BJ(J)*DEXP(-EJ (J)/TE1  ) 

IF  (J.EQ.21)  KJ (J+l)  - AJ (J)*TE1  **BJ ( J ) *DEXP ( - EJ ( J ) /TE1  ) 

IF(TE1.LT.2.D3)G0  TO  132 

IF( J.EQ.19)  KEQ-(1 . 8D-08)*(TE1**1 . 5D0)*DEXP( - 1 . 69D5/TE1) 

IF(J . EQ. 21)  KEQ-(3 . 59D-09)*(TE1**1 . 5D0)*DEXP( -1 . 575D5/TE1) 

132  KJ (J)  - KJ (J+1)*KEQ 
ENDIF 

ENDIF 

IF  (NUIJ (IMAX+1 , J) . EQ . 0)  SJ(J)  - 1.0 
IF  (NUIJ (IMAX+1 ,J) . EQ. 0)  GO  TO  140 
SUM  - 0.0 

DO  135  ISUM  - l.IMAX 

135  SUM  - SUM  + AIJ (ISUM, J)*CI (ISUM) /MUI (ISUM) 

SJ(J)  - RHO*SUM 
140  PROD  - 1.0 

DO  180  IPROD  - l.IMAX 

IF  (NUIJ (IPROD ,J) . EQ . 0)  GO  TO  180 

TEM  - RHO*CI( I PROD) /MUI (IPROD) 

IF  (TEM. GE. 0.0)  GO  TO  165 

LET  PROBLEM  COMPUTE  PROD.  WHEN  Cl  NEG  ; DECIDE  IN  MAIN 'ABOUT  ACCEPTING  NEG  Cl 
LABW  - MOD (NUIJ (IPROD , J) ,2) 

LABW  - 0 FOR  EVEN  NUIJ,  ABW  - 1 FOR  ODD  NUIJ 
IF  (LABV.EQ.O)  PROD  - PROD*( -TEM)**NUIJ ( IPROD ,J ) 

IF  (LABU.EQ.l)  PROD  - - 1 . 0*PROD*( -TEM) **NUIJ (IPROD ,J) 

GO  TO  180 

165  PROD  - PROD*TEM**NUIJ ( IPROD, J) 

180  CONTINUE 

IF  (ICT.EQ.l)  PRODF  - PROD 
BETAIJ  - NUPIJ (I , J)  - NUIJ (I , J) 

DCIJDX(J)  - PHI(J)*KJ(J)*SJ(J)*(MUI(I)/(RHO*U))*PROD*BETAIJ 

DCIDX  - RATE  OF  PRODUCTION  OF  THE  CONCENTRATION  OF  SPECIE  I 
DCIDX(I)  - DCIDX(I)  + DCIJDX(J) 

IF  (ICT.EQ.O. AND. MODEL. GT.l)  THEN 

QIJ  - NET  RATE  OF  PRODUCTION 

QIJ  - DCIJDX(J-l)  + DCIJDX(J) 

DENOM  - KEQ*PHI(J-l)*SJ(J-l)*PRODF 
IF  (DENOM. EQ. 0.0)  GO  TO  190 

CHI  - DEGREE  OF  NON -EQUILIBRIUM 

CHI  - 1.0  - (PHI(J)*SJ(J)*PROD/DENOM) 

DENOM1  - Cl (I)*CHI 
IF  (DENOM1 . EQ . 0 . 0)  GO  TO  190 


CVSUM1  - CVSUMl  + QIJ/DEN0M1 
CVSUM2  - CVSUM2  + QIJ*(1.0  - CHI)/DENOMl 
ENDIF 

190  CONTINUE 

IF(I . EQ. 7)WE1-DCIJDX(19)+DCIJDX(20) 

IF(I . EQ. 7)WE2-DCIJDX(21)+DCIJDX(22) 

C IF  (I.EQ.7)WRITE(*,191)WE1 

191  FORMAT ( ' WEI  - \E13.3) 

C 

TEM  - DEXP ( THETAI ( I ) /T) 

TEM1  - ( FI ( I ) *DGENI ( I ) *R*THETAI ( I ) ) /MUI ( I ) 

EVIBAR(I)  - TEM1/(TEM  - 1.0) 

IF  (M.NE.O)  GO  TO  195 
VAR(I+IMAX+2)  - EVIBAR(I) 

DEVIDX(I)  - 0.0 
GO  TO  210 
195  TAUSUM  - 0.0 

IF  (FI(I).EQ.O.O)  GO  TO  210 

C CVD  MODEL 

DO  200  K - 1 , IMAX 
TEM3  - DEXP( -THETAI (I)/T) 

TEM4  - DEXP(SIGIK(K,I)*T**(-l./3. )) 

TEM5  - (FI (I)*ALPIK(K, I) )/PFTL 

TAUIK  - TEM5*(T**BETAIK(K, I)*TEM4)/(1 . 0 - TEM3) 

C MILLIKAN  & WHITE  RELAXATION  DATA 

IF  (MW. EQ. 1)  THEN 

IF  (I.EQ.l)  TAUIK  - 1.9E-05*DEXP(216.45*T**(-l./3.))/PFTL 
IF  (I.EQ.8)  TAUIK  - 3 . 1845E-05*DEXP(198 . 66*T**( -1./3 . ) )/PFTL 
ENDIF 

TEM6  - Cl (K)*(EVIBAR(I)  - EVI(I)) 

C PARK  MODEL 

IF  (MODEL. EQ. 4. AND. I.EQ.l)  THEN 
TAULP  - TAUIK  + TAUC 

PF  - DABS ( (T  - TVI (I) )/ (TS  - TINF))**(SP  - 1.) 

TAUSUM  - TAUSUM  + (TEM6/(TAULP*U) )*PF 
GO  TO  200 
ENDIF 

TAUSUM  - TAUSUM  + TEM6/(TAUIK*U) 

200  CONTINUE 

IF  (MODEL. EQ.l)  GO  TO  207 
IF  (MODEL. EQ. 3)  GO  TO  202 

C ADDITIONAL  TERMS  FOR  CVDV  & PARK  MODEL 

IF  (I. EQ. 5. OR. I. EQ. 6. OR. I.EQ.8)  GO  TO  207 
TEM7  - DEXP ( THETAI ( I ) /TVI ( I ) - THETAI ( I )/T) 

TEM8  - DEXP (NI ( I ) *THETAI ( I ) /TVI ( I ) ) *DEXP ( -NI ( I ) *THETAI ( I ) /T) 

CVDVT  - ( (THETAI (I)/(TEM7  - 1.)  - NI(I)*THETAI(I)/(TEM8  - 1.)) 

* *R/MUI (I)  - EVI (I) )*CVSUM1  - ((0.5*(NI(I)  - 1 . ) *THETAI ( I ) 

* *R/MUI ( I ) ) - EVI ( I ) ) *CVSUM2 
TAUSUM  - TAUSUM  + CVDVT 

GO  TO  207 

C ADDITIONAL  TERMS  FOR  CVDV- PREFERENTIAL  MODEL 

202  IF  (I. EQ. 5. OR. I. EQ. 6. OR. I.EQ.8)  GO  TO  207 
USUM1  - 0.0 
USUM2  - 0.0 
TFSUM1  =0.0 
TFSUM2  =0.0 
NIC  = NIP(I)  + 1 

TF  = 1 . 0/(1 . /TVI (I)  - l./T  - l./UP(I)) 

DO  204  N = l.NIC 
XN  = N 


I 


EEVP  - XN  - 0.5 

EVP(N)  - EEVP*(WE(I)  + EEVP*( -WEXE(I)  + EEVP*(WEYE(I)  + 

* WEZE(I)*EEVP) ) ) 

EVP(N)  - EVP(N)  - EVP(l) 

USUMl  - USUM1  + DEXP(EVP(N)/UP(I) ) 

USUM2  - USUM2  + EVP(N)*DEXP(EVP(N)/UP(I)) 

TFSUM1  - TFSUM1  + DEXP( -EVP(N)/TF) 

204  TFSUM2  - TFSUM2  + EVP(N)*DEXP( -EVP(N)/TF) 

GBAR  - (USUM2/USUM1)*(R/MUI(I) ) 

EBAR  - (TFSUM2/TFSUM1)*(R/MUI(I) ) 

CVDVPT  - (EBAR  - EVI ( I ) ) *CVSUM1  - (GBAR  - EVI ( I ) ) *CVSUM2 
TAUSUM  - TAUSUM  + CVDVPT 

C DEVIDX  - EQUILIBRIUM  VIBRATIONAL  ENERGY 

207  DEVIDX(I)  - TAUSUM 

DER(1+IMAX+I)  - DEVIDX(I) 

210  CONTINUE 

C COMPUTE  DHDX 

DHDX  - DPFTL/RHO 
RETURN 
END 
C 

C - - 

c 

SUBROUTINE  FOFE  (MAXI ,T0L1 ,T0L2 , ICODE,  El) 

C 

C CALLED  BY  SUB  BASIC  TO  EVALUATE  E BY  NEWTON  ITERATION  TECHNIQUE 
C 

IMPLICIT  REAL*8(A-H,0-Z) 

COMMON  /Al/  M, IX, IMAX, IPS I , MODEL, TE1 , TE2 
COMMON  /A2/  P(200) ,DPDX(200) ,VARI(200) 

COMMON  /A3/  EVIINF(25) ,THETAl(25) ,MUI(25) ,FI(25) ,DELHI(25) , 

* CIINF(25) ,LI(25) 

COMMON  /A4/  R.MUINF, DELTA, LAMSQ , OMEGSQ , OMEGA, MU, T.U.TINF 
COMMON  /A5/  EPSIIL(20 , 25) ,GIL(20,25) ,CID(200,4) 

COMMON  /A6/  VAR(52) ,CUVAR(52) ,DER(51) 

COMMON  /A7/  MJ(50) ,EJ(50) ,AJ(50) ,BJ(50) ,DIRECT(50) 

COMMON  /A8/  TVI(25) ,NI(25) ,DGENI(25) ,BI(25) 

COMMON  /A10/  NUIJ (26,50) ,AIJ (25,50) ,NUPIJ (25,50) 

COMMON  /A15/  PFTL.KITRl ,NIP(25) ,UP(25) 

COMMON  /A18/  ITNEG.IEXP 
DIMENSION  CI(25) 

EQUIVALENCE  (CUVAR(3) ,CI(1)) , (CUVAR(2) ,H) 

REAL* 8 MUI, LAMSQ, MUINF, MU 
C 

IF  (I EXP . EQ . 1 . OR. ITNEG . EQ . 1)  RETURN 
KITR1  - KITR1  + 1 
ITER  - 0 
PORHO  - H - El 
T - PORHO*MU/R 
1 ITER  - ITER  + 1 
E - 0.0 
DE  - 0.0 

DO  35  I - 1 , IMAX 
IF  (TVI(I) .EQ.0.0)  THEN 

TEM1  - (1.5*R*T)/MUI(I)  + (FI(I)*R*T)/MUI(I) 

DTEM1  - 1.5*R/MUI(I)  + FI(I)*R/MUI(I) 

GO  TO  15 
END  IF 

TEM  = DEXP ( THETAI ( I ) /TVI ( I ) ) 

TEM1  - (1.5*R*T)/MUI(I)  + (FI(I)*R*T)/MUI(I)  + 


* (FI(I)*R*THETAI(I))/(MUI(I)*(TEM  - 1.0)) 

DTEM1  - 1.5*R/MUI(I)  + FI(I)*R/MUI(I)  + (R*FI ( I ) *THETAI ( I ) **2 ) 

* /(MUI(I)*TVI(I)**2)*(TEM/(TEM  - 1.0)**2) 

15  SUMG  - 0.0 

SUMGE  - 0.0 
DSUMGE  - 0.0 
LI I - LI (I) 

C 

DO  25  L - l.LII 
TEM3  - - EPSIIL(L, I)/T 
IF  (TEM3.LT. 741. 67)  GO  TO  22 
I EXP  - 1 
RETURN 

22  TEM2  - DEXP(TEM3) 

SUMG  - SUMG  + GIL(L, I)*TEM2 
SUMGE  - SUMGE  + GIL(L, I)*EPSIIL(L, I)*TEM2 
IF  (SUMGE.LT. 1.0D+34)  GO  TO  25 
I EXP  - 1 
RETURN 

25  DSUMGE  - DSUMGE  + TEM2*GIL(L, I)*EPSIIL(L, I)**2 

DEVI  - R/MUI ( I ) * ( ( ( SUMG*DSUMGE/T**2 ) - (SUMGE/T)**2) 

* /SUMG**2) 

DEI  - DTEM1  + DEVI 

El  - TEM1  + R/MUI (I)*(SUMGE/SUMG)  + DELHI (I)/MUI (I) 

DE  - DE  + DEI*CI (I) 

E - E + EI*CI (I) 

35  CONTINUE 
C 

IF  (E.GT.H)  ITNEG  - 1 
DFT  - - DE 
FT  - El  - E 
IF  (DFT. EQ. 0.0)  THEN 
ICODE  - 2 
RETURN 
ENDIF 

TS1  - T - (FT/DFT) 

DELT  - DABS (TS1  - T) 

T - TS1 

El  - H - R*T/MU 
IF  (ITER. GE. MAXI)  THEN 
ICODE  - 1 
RETURN 
ENDIF 

IF  (DELT.GT.TOL1)  THEN 
ITER1  - ITER 
GO  TO  1 
ENDIF 

ITER2  - ITERl  + 10 

IF  ( DELT. LE.TOL2. OR. ITER. GE.ITER2)  RETURN 
GO  TO  1 
END 
C 

C 

C 

SUBROUTINE  FOFTS1  (MAXI , TOL1 , TOL2 , ICODE , TSG) 

C 

C CALLED  BY  MAIN  TO  EVALUATE  TS  BY  NEWTON  ITERATION  TECHNIQUE 

C 

IMPLICIT  REAL*8(A-H,0-Z) 

COMMON  /Al/  M, IX, IMAX, IPS I .MODEL, TE1 , TE2 


COMMON  /A2/  P(200) ,DPDX(200) ,VARI(200) 

COMMON  /A3/  EVIINF(25) ,THETAI(25) ,MUI(25) ,FI(25) ,DELHI(25) 

* ,CIINF(25) ,LI(25) 

COMMON  /A4/  R, MUINF, DELTA, LAMSQ , OMEGSQ , OMEGA, MU, T,U,TINF 
COMMON  /A5/  EPSIIL(20 , 25) ,GIL(20,25) ,CID(200,4) 

COMMON  /A6/  VAR(52) ,CUVAR(52) ,DER(51) 

REAL*8  MU I , LAMSQ, MUINF, MU 
C 

ITER  - 0 

1 ITER  - ITER  + 1 
ES  - 0.0 
DES  - 0.0 
DO  25  I - l.IMAX 
IF  (M.EQ.l)  EVIS  - EVIINF(I) 

IF  (M.EQ.l)  GO  TO  5 
TEM  - DEXP(THETAI(I)/TSG) 

EVIS  - (R*THETAI(I))/(MUI(I)*(TEM-1.0))*FI(I) 

DEVIS  - (R*FI (I)*THETAI(I)**2)/(MUI (I)*TSG**2)*(TEM/(TEM-1 . 0)**2) 
5 SUMG  - 0.0 
SUMGE  - 0.0 
DSUMGE  - 0.0 
LI I - LI (I) 

C 

DO  10  L - l.LII 

TEM1  - DEXP(-  EPSIIL(L,I)/TSG) 

SUMG  - SUMG  + TEM1*GIL(L, I) 

SUMGE  - SUMGE  + TEM1*GIL(L, I)*EPSIIL(L,  I) 

10  DSUMGE  - DSUMGE  + TEM1*GIL(L, I)*EPSIIL(L, I)**2 
EEIS  - (R/MUI (I) )*(SUMGE/SUMG) 

DEE IS  - R/MUI ( I ) * ( ( ( SUMG*DSUMGE/TSG**2 ) - (SUMGE/TSG)**2) 

* /SUMG**2) 

EIS  - ( 1 . 5*R*TSG ) /MUI ( I ) + (FI(I)*R*TSG)/MUI(I)  + EVIS  + EEIS 

* + DELHI ( I ) /MUI ( I ) 

DEIS  - 1.5*R/MUI(I)  + FI ( I ) *R/MUI ( I ) + DEVIS  + DEEIS 
ES  - ES  + EIS*CIINF(I) 

DES  - DES  + DEIS*CIINF(I) 

25  CONTINUE 
C 

FAC  - DSQRT( OMEGSQ  - 2 . 0*LAMSQ* ( DELTA  - ES)) 

FIN  - ( 2 . 0*MUINF* (DELTA  - ES)*FAC)/(R*( OMEGA  + FAC)) 

FTS  - TSG  - FIN 

FAC1  - R*  ( OMEGA+FAC  ) * ( MUINF*  ( DELTA  - ES  ) * ( 2 . 0/FAC  ) *LAMSQ*DES  - 

* 2.0*FAC*MUINF*DES)  - 2 . 0*MUINF*( DELTA -ES)*R*LAMSQ*DES 
FAC2  - R**2*( OMEGA  + FAC)**2 

DFTS  - 1.0  - FAC1/FAC2 
IF  (DFTS. EQ. 0.0)  THEN 
ICODE  - 2 
RETURN 
END  IF 

TSG1  - TSG  - (FTS/DFTS) 

DELTS  - DABS (TSG1  - TSG) 

TSG  - TSG1 

IF  (ITER. GE. MAXI)  THEN 
ICODE  - 1 
RETURN 
END  IF 

IF  ( DELTS. GT.TOL1)  THEN 
ITER1  - ITER 
GO  TO  1 
END  IF 


oooooo  ooo 


ITER2  - ITER1  + 10 

IF  (DELTS .LE.T0L2 .OR. ITER.GE.ITER2)  RETURN 

GO  TO  1 

END 


SUBROUTINE  CHECK 

CHECK  CALLED  BY  CALINTH  TO  MAKE  DECISION  TO  ACCEPT  ANSWERS 
IF  ACCEPTABLE  ; SET  ELB  - 0 AND  RETURN 

IF  NOT  ACCEPTABLE  ; MODIFY  SPEC  AND  Cl  ; SET  ELB  - 1.0  AND  RETURN 

IMPLICIT  REAL*8(A-H,0-Z) 

COMMON  /Al/  M, IX, IMAX, IPSI, MODEL, TE1.TE2 
COMMON  /A2/  P(200) ,DPDX(200) ,VARI(200) 

COMMON  /A3/  EVIINF(25) ,THETAl(25) ,MUI(25) ,FI(25)  ,DELHI(25) , 

* CIINF(25) ,LI(25) 

COMMON  /A4/  R,MUINF, DELTA, LAMSQ , OMEGSQ , OMEGA, MU, T,U,TINF 
COMMON  /A5/  EPSIIL(20 , 25) , GIL(20 , 25) , CID(200 ,4) 

COMMON  /A6/  VAR (52) , CUVAR(52) ,DER(51) 

COMMON  /A13/  DELX, ZSTERM, IZTERM,NSR,MW, SP ,TS 
COMMON  /A17/  ELB , SPEC , CJ , TPREV , HPREV ,HCHECK,TCHECK 
COMMON  /A18/  ITNEG , I EXP 
REAL* 8 MUI, MU, MUINF, LAMSQ 
EQUIVALENCE  (CUVAR(2) ,H) 

C 

IF  (IEXP.NE. 1)  GO  TO  1 
GO  TO  15 

C REDUCE  COMPUTING  INTERVAL  TO  TRY  AND  AVOID  EXP  ERROR  STOP 

1 IF  (ITNEG. EQ.O)  GO  TO  4 

C E.GT.H  SOMETIMES  LEADS  TO  NEG  T- -REDUCE  INTERVAL  TO  TRY  TO  AVOID  INSTABILITY 
GO  TO  15 

4 IMAXP1  - IMAX  + 1 
DO  10  I - 3 , IMAXP1 

C CUVAR(2)  - H MAY  BE  NEGATIVE 

IF  (CUVAR(I) .LT.0.0)  WRITE(*,5)  I , IX, CUVAR(I) 

IF  (CUVAR(I) .LT.0.0)  GO  TO  15 

5 FORMAT (IX, 'NEG  Cl  AT  I - ',13, IX, 'IX-  ' , 13 , IX, ' CUVAR(I)  - ', 

* E12. 5, IX, 'IN  SUB  CHECK'/) 

10  CONTINUE 

IF  (IX.LT.3)  GO  TO  30 

IF  ((IPSI.EQ. (NSR+1)) .AND. (IX.LT. (NSR+3)))  GO  TO  30 
IF  (DABS (TPREV  - T) /T . LT . TCHECK)  GO  TO  25 
WRITE(* , 11) 

11  FORMAT (IX, 'CHECK  ABS ( TPREV - T) /T . GE . TCHECKT  IN  SUB  CHECK'/) 

15  IF  (SPEC . GT . 1 . 0E- 15)  GO  TO  20 

WRITE(*,*) 'SPEC  .LT.  1.0E-15  IN  SUB  CHECK  STOP  30' 

STOP 

C STOP  30 

C ‘ REDUCE  INTERVAL 

20  SPEC  - SPEC/4.0 
CJ  - SPEC 
ELB  = 1.0 

WRITE (* , 22 ) SPEC , IPSI , IX, T , TPREV , H , HPREV , IEXP , ITNEG 
22  FORMAT (IX, 'REDUCED  SPEC-  ' , E9 . 4 , 2X, ' IPSI  - ',I3,2X,'IX=  ',13, 

* 2X,'T  - ' ,E9.4,2X, 'TPREV  - ' , E9 . 4 , / , IX, ' H - '.E9.4.3X, 

* 'HPREV  = ' ,E9.4,3X, 'IEXP  = ', 13 , 3X, ' ITNEG  = ',13,'  IN  CHECK'/) 

ITNEG  = 0 


o u o 


i exp  - o 

RETURN 

25  IF  (DABS((HPREV  - H)/H) .GT.HCHECK)  WRITE(*,27) 

27  FORMAT (IX, 'CHECK  ABS ( (HPREV-H)/H) .GT.HCHECKT  IN  SUB  CHECK'/) 

IF  (DABS( (HPREV  - H)/H) .GT.HCHECK)  GO  TO  15 
C ACCEPTABLE 

30  TPREV  - T 
HPREV  - H 
ELB  - 0.0 
RETURN 
END 


SUBROUTINE  SHOCKG  (NXPSTM1 , ITK) 

C 

C SUBROUTINE  SHOCKG  CALLED  BY  MAIN  AND  MUST  BE  SUPPLIED  BY  USER. 

C X,ZS,RS,RC, COST, SINT  FOR  EACH  X FROM  0.0  TO  X AT  ZSTERM  IN  INCREMENTS 
C OF  (DELX/NSR)  TO  DELX  AND  INCREMENTS  OF  DELX  THEREAFTER. 

C 

C X - DISTANCE  ALONG  SHOCK 

C ZS  DISTANCE  ALONG  SHOCK  AXIS  OF  SYMMETRY 

C RS  - RADIUS  OF  SHOCK 

C RC  RADIUS  OF  CURVATURE  OF  SHOCK 

C COST  - COS  OF  ANGLE  OF  ATTACK 

C SINT  - SIN  OF  ANGLE  OF  ATTACK 

C 

IMPLICIT  REAL*8 (A-H, O-Z) 

COMMON  /A9/  EVIS(25) ,XPST(100) 

COMMON  /Al2/  SINTM(200) ,COSTM(200) ,RSM(200) ,RCM(200)  ,X1(200) 

* , ZSM(200) 

COMMON  /A13/  DELX, ZSTERM, IZTERM, NSR, MW, SP.TS 

DIMENSION  ZDUM(501) ,RSDUM(501) ,RCDUM(501) ,XC(501) , CODUM(501) , 

* SIDUM(501) 

C Rs/L  - SQRT(2*R*Zs/L  - Bs*(Zs/L)**2)  WHERE:  L - 1.0  cm 

ITK  - 0 
EL  - 1.0 
R - 230.0 
BS  - -4.0 
DO  5 I - 2,501 

5 ZDUM(I)  - (I-l)*ZSTERM/500 
ZDUM(l)  - 0.0 
RSDUM(l)  - 0.0 
XC(1)  - 0.0 
CODUM(l)  - 0.0 
SIDUM(l)  - 1.0 
RCDUM(l)  - 230.0 
C 

DO  10  I - 2,501 
ZSND  - ZDUM ( I ) /EL 

RSDUM(I)  - DSQRT ( 2 . *R*ZSND  - BS*ZSND**2) 

C - 1 . 0/(R  - BS*ZSND)**2 

Cl  - DSQRT ( C*RSDUM( I ) **2  +1.0) 

XC(I)  - RSDUM(I)/2 . *C1  + l./(2.*DSQRT(C))*DLOG(RSDUM(I)*DSQRT(C) 

* + Cl) 

D1  - (R  - BS*ZSND) /RSDUM(I) 

D2  - - (R  - BS*ZSND)**2/RSDUM(I)**3  - BS/RSDUM(I) 

THETA  - ATAN(Dl) 

SIDUM(I)  - DS IN (THETA) 

CODUM(I)  - DCOS (THETA) 

Cl* 


RCDUM(I)  - (1.0  + Dl**2)**l. 5/DABS (D2) 

C DIMENSIONALIZED  QUANTITIES 

RCDUM(I)  - EL*RCDUM ( I ) 

XC(I)  - EL*XC ( I ) 

RSDUM(I)  - EL*RSDUM(I) 

10  CONTINUE 
C 

WRITE(* , 25) 

WRITE(8 , 25) 

25  FORMAT ( 5X , 'X' ,11X,  'ZS' ,10X,  'RS' ,10X, 'RC' , 9X. ' COST' , 8X, ' SINT' /) 

NOX  - 0 
M - 1 
NZS  - 501 

C INTERPOLATE  SHOCK  VALUES  TO  X SHOCK  COORDINATE 

30  NOX  - NOX  + 1 

IF  (NOX.LT. (NSR+2))  X - X + DELX/NSR 
IF  (NOX. EQ . 1)  X - 0.0 
IF  (NOX.GT. (NSR+1))  X - X + DELX 
CALL  FTLUP  (X,ZS,M,NZS,XC,ZDUM) 

CALL  FTLUP  (X,RS ,M,NZS ,XC,RSDUM) 

CALL  FTLUP  (X,RC,M,NZS ,XC,RCDUM) 

CALL  FTLUP  (X, COST ,M, NZS ,XC , CODUM) 

CALL  FTLUP  (X, SINT, M, NZS ,XC , SIDUM) 

WRITE(8 , 35)  X,ZS,RS,RC, COST, SINT, NOX 
WRITE(*,35)  X,ZS,RS,RC, COST, SINT, NOX 

35  FORMAT (IX, 6 (E10 . 4 , 2X) , 14) 

SINTM(NOX)  - SINT 
COSTM(NOX)  - COST 
RSM(NOX)  - RS 

RCM(NOX)  - RC 
XI (NOX)  - X 
ZSM(NOX)  - ZS 
DO  36  IT  - 2 ,NXPSTM1 

IF  (DABS (XPST(IT)  - X) . GT. 1 . 0E-06)  GO  TO  36 
ITK  - ITK  + 1 

36  CONTINUE 

IF  (ZS.GE.0.0)  GO  TO  40 
WRITE(*,37)  ZS 

37  FORMAT (IX, 'ZS  SHOULD  BE  GREATER  THAN  0.0  : ZS  - \E10.5, 

* /, IX, 'STOP  13'/) 

STOP 

c STOP  13 

40  IF  (ZS.LT.ZSTERM)  GO  TO  30 
IZTERM  - NOX 
RETURN 
END 
C 
C 
C 

C 
C 
C 
C 
C 


£81° 


SUBROUTINE  CALINTH  (N, CIMAX, PHMAX) 

IN  THE  CALINTH  VERSION  OF  CALINT,  THE  VARIABLE  IN  VAR(2)  AND 
CUVAR(2)  MAY  BE  + OR  -.  VALUES  OF  OTHER  DEPENDENT  VARIABLES 
ARE  EXPECTED  TO  BE  POSITIVE.  10-69 

IMPLICIT  REAL*8 (A-H.O-Z) 

COMMON  /Al/  M , IX , IMAX , IPS I , MODEL , TE1 , TE2 
COMMON  /A2/  P(200) ,DPDX(200) ,VARI(200) 

COMMON  /A3/  EVIINF(25) ,THETAI(25) ,MUI(25) ,FI(25) ,DELHI(25) , 

* CIINF(25) ,LI(25) 


o n o o 


COMMON  /A4/  R.MUINF, DELTA, LAMSQ , OMEGSQ . OMEGA, MU, T.U.TINF 
COMMON  /A5/  EPSIIL(20 , 25) ,GIL(20,25) ,CID(200,4) 

COMMON  /A6/  VAR(52) ,CUVAR(52) ,DER(51) 

COMMON  /A7/  MJ(50),EJ(50),AJ(50),BJ(50) ,DIRECT(50) 

COMMON  /A8/  TVI(25) ,NI(25) ,DGENI(25) ,BI(25) 

COMMON  /A10/  NUIJ (26 , 50) ,AIJ(25 , 50) ,NUPIJ(25 , 50) 

COMMON  /All/  SIGIK(25 , 25)  , ALPIK(25 , 25) , BETAIK(25 , 25) 

COMMON  /A17/  ELB , SPEC , CJ , TPREV , HPREV , HCHECK , TCHECK 
COMMON  /A19/  ELE1(51) ,ELE2(51) ,NERR 
REAL* 8 MUI , MU , MUINF , LAMSQ 

DIMENSION  Fl(51) ,F2(51) ,F3(51) ,CAPF1(51) ,CAPF2(51) ,CAPF3(51) 

* ,P1(51) ,PH(51) ,DELTY(51) ,Y3(51) , Y4(51) , F4(51) ,Y2(51) 

IF  CJ  OR  N IS  EQUAL  TO  ZERO  : NERR  - 1 

IF  ELE1  IS  LESS  THAN  OR  EQUAL  TO  ELE2  : NERR  - 2 

TEST  INPUT 

FN  - N 

TEST  - CJ*FN 
IF  (TEST)  998,997,998 

997  NERR  - 1 
RETURN 

998  DO  999  I - 1,N 

IF  ( ( ELE1 ( I ) - ELE2(I)) .LE.0.0)  THEN 
NERR  - 2 
RETURN 
END  IF 

999  CONTINUE 

1000  IF  (SPEC)  5,1,5 

C SECTION  FOR  INITIALIZATION  COMPUTATION  OF  DERIVATIVES 

1 SPEC  - CJ 
ICONT  - 1 

2 N1  - N + 1 

DO  3 I - 1,N1 

3 CUVAR(I)  - VAR(I) 

CALL  BASIC 

C RETURN  WITH  DERIVATIVES  IN  DER 

DO  4 I - 1 ,N 

4 FI (I)  - DER(I) 

RETURN 

C COMPUTE  Y2,X2 

5 CUVAR(l)  - VAR(l)  + CJ/2.0 
DO  6 I - 1,N 

II  - I + 1 

Y2(I)  - VAR(Il)  + CJ/2 . 0*F1(I) 

IF  (I.EQ.l)  GO  TO  6 
IF  (Y2(I) ) 65,6,6 

6 CUVAR(Il)  - Y2(I) 

GO  TO  66 

65  SPEC  - CJ 
CJ  - CJ/2.0 
GO  TO  5 

C CALL  BASIC  TO  EVALUATE  F2 

66  CALL  BASIC 

C RETURN 

DO  7 I - 1 ,N 
II  - I + 1 
F2 (I)  = DER ( I ) 

C COMPUTE  Y3 

Y3(I)  - VAR(Il)  + CJ/2 . 0*F2(I) 

IF  (I.EQ.l)  GO  TO  7 


c 


7 


IF  (Y3(I) ) 65,7,7 
CUVAR(Il)  - Y3(I) 


CALL  BASIC  TO  EVALUATE  F3 


C 


C 


8 

9 

91 

83 


103 

84 

85 


95 


10 


C 


102 


101 

11 


C 

13 


94 

955 

96 


C 

15 

16 
C 


165 

C 


CALL  BASIC 


RETURN 


DO  10  I - 1,N 

F3(I)  - DER(I) 

COMPUTE  P, PH  AND  CAP  F TERMS 

IF  (Y3(I)  - Y2(I) ) 9,8,9 
P1(I)  - 0.0 
GO  TO  91 

P1(I)  - - ( (F3(I)  - F2(I))/(Y3(I)  - Y2(I) ) ) 

PH(I)  - P1(I)*CJ 
IF  (PH(I))  83,83,103 
PH(I)  - 0.0 
P1(I)  - 0.0 
GO  TO  84 

Z1  - DABS (Y3 (I)  - Y2(I) )/( (DABS (Y3 (I) ) + DABS(Y2 (I) ) )/2 . 0) 

IF  (Z1  - 0.5E-04)  83,83,84 
IF  ( PH ( I ) - 0.1)  85,85,95 

CAPFl(I)  - 1.0  - PH ( I ) /2 . 0 + PH(I)**2/6 .0  - PH(I)**3/24 . 0 
CAPF2(I)  - 0.5  - PH(I)/6 . 0 + PH(I)**2/24.0  - PH(I)**3/120.0 
CAPF3 (I)  - 1./6 . - PH(I)/24 . + PH(I)**2/120 . - PH(I)**3/720 . 
GO  TO  10 

CAPFl(I)  - (DEXP(-PH(I))  - 1.0)/(-  PH ( I ) ) 

CAPF2 (I)  - (CAPFl(I)  - 1.0)/(-  PH ( I ) ) 

CAPF3 (I)  - ( CAPF2 ( I ) - 0.5)/(-  PH(I)) 

CONTINUE 

IS  PH  BETWEEN  ELE2  AND  ELE1 


IF  (ICONT  - 1)  101,101,102 
ICONT  - ICONT  - 1 
SPEC  - CJ 
GO  TO  17 
DO  11  I - 1 ,N 

IF  (DABS (PH(I) ) - ELEl(I))  11,11,13 
CONTINUE 
SPEC  - CJ 
GO  TO  15 

HALVE  INTERVAL  AND  DOUBLE  PH  RANGE 

DO  96  I - 1,N 
ELEl(I)  - ELE1(I)*2 . 0 
IF  (ELE1(I)  - PHMAX)  94,94,955 
ELE2 ( I ) - ELE2 (I)*2 . 0 
GO  TO  96 

ELE1(I)  - ELEl(I)/2 . 0 

CONTINUE 

SPEC  - CJ 

CJ  - CJ/2.0 

ICONT  - 3 

GO  TO  5 

RETURN  TO  RECOMPUTE  INTERVAL 

DO  16  I - 1,N 

IF  (DABS (PH(I) ) - ELE2 ( I ) ) 16,17,17 
CONTINUE 

DOUBLE  INTERVAL 

CJ  - 2 . 0*CJ 

IF  (CJ  - CIMAX)  17,17,165 
CJ  - CIMAX 


17 


DO  18  I - 1,N 


COMPUTE  Y4,X4 


non  on  o o o o no 


ii  - i + i 

CUVAR(Il)  - VAR(Il)  + SPEC*(F3(I)*(2.0*CAPF2(I))  + F1(I)* 

* (CAPFl(I)  - 2 . 0*CAPF2 ( I ) ) + F2(I)*PH(I)*CAPF2(I)) 

IF  (I.EQ.l)  GO  TO  18 

IF  (CUVAR(Il) ) 175,18,18 
175  CJ  - SPEC 
CJ  - CJ/2.0 
GO  TO  5 

18  Y4(I)  - CUVAR(Il) 

CUVAR(l)  ~ VAR(l)  + SPEC 

CALL  BASIC  TO  EVALUATE  F4 

CALL  BASIC 

RETURN 

DO  20  I - l.N 
II  - I + 1 
F4(I)  - DER(I) 

COMPUTE  DELTA  Y 

DELTY(I)  - SPEC*(F1 (I)*CAPFl(I)+( -3 . 0*(F1(I)+P1(I)*VAR(I1) )+2 . 0* 

* (F2(I)+P1(I)*Y2(I) ) + 2 . 0*(F3(I)+P1(I)*Y3(I) ) - F4(I)  - P1(I)* 

* Y4 ( I ) ) *CAPF2 ( I ) + 4.0*( (F1(I)+P1(I)*VAR(I1) ) - (F2(I)+P1(I)* 

* Y2(I) ) - (F3(I)+P1(I)*Y3(I) ) + (F4(I)+P1(I)*Y4(I) ) )*CAPF3 (I) ) 

COMPUTE  Y + DELTA  Y 

20  CUVAR(Il)  - VAR(Il)  + DELTY(I) 

CALL  CHECK  FOR  DECISION  TO  ACCEPT  OR  RECOMPUTE  INTERVAL 

CALL  CHECK 
IF  (ELB)  21,21,23 

UPDATE  Y VALUES 

21  N1  - N + 1 

DO  22  I - 2 ,N1 
II  - I - 1 

22  VAR(I)  - VAR(I)  + DELTY(Il) 

VAR(l)  - VAR(l)  + SPEC 

RETURN  TO  COMPUTE  DERIVATIVES  AT  Y + DELTA  Y 

GO  TO  2 

RETURN  TO  RECOMPUTE  INTERVAL 

23  GO  TO  5 
END 


SUBROUTINE  FTLUP  (X,Y,M,N,VARI,VARD) 

C 

C THIS  SUBROUTINE  IS  A MODIFICATION  OF  LIBRARY  INTERPOLATION 
C SUBROUTINE  FTLUP  REVISED  7-7-69 
C 

IMPLICIT  REAL*8 (A-H , O-Z) 

DIMENSION  VARI(l) ,VARD(1) ,V(3) , YY(2) , II (100) 

C INITIALIZE  ALL  INTERVAL  POINTERS  TO  -1.0  FOR  MONOTONICITY  CHECK 

DO  4 J - 1,100 
4 II(J)  - -1 
MA  - IABS(M) 

C ASSIGN  INTERVAL  POINTER  FOR  GIVEN  VARI  TABLE  ; THE  SAME  POINTER 

C WILL  BE  USED  ON  A GIVEN  VARI  TABLE  EVERY  TIME 

LOCF  = VARI(l) 

LI  - M0D(L0CF, 100)  + 1 
I - II (LI ) 

IF  (I.GE.O)  GO  TO  10 
IF  (N.LT.2)  GO  TO  10 


c 


IF  (VARI (2)  - VARI(l))  1,1,3 


MONOTONICITY  CHECK 


C ERROR  IN  MONOTONICITY 

2 K - LOCF 

WRITE (*, 102)  J ,K 

102  FORMAT (IX,  'TABLE  BELOW  OUT  OF  ORDER  FOR  FTLUP  AT  POSITION  ' , 

* 15 ,//, IX, 'X  TABLE  IS  STORED  IN  LOCATION' , 15//) 

DO  103  J - 1,N 

103  WRITE(*,*)  VARI(J) ,VARD(J) 

STOP 

c MONOTONIC  DECREASING 

1 DO  5 J - 2,N 

IF  (VARI (J)  - VARI(J-l))  5,2,2 

5 CONTINUE 
GO  TO  10 

c MONOTONIC  INCREASING 

3 DO  6 J - 2,N 

IF  (VARI(J)  - VARI ( J -1) ) 2,2,6 

6 CONTINUE 

C INTERPOLATION 

10  IF  (I.LE.O)  I - 1 

IF  (I.GE.N)  I - N - 1 
IF  (N.LE.l)  GO  TO  8 
IF  (MA.NE.O)  GO  TO  99 

C ZERO  ORDER 

8 Y - VARD(l) 

GO  TO  800 

C LOCATE  I INTERVAL  (X(I) .LE.X.LT.X(I+1) ) 

99  IF  ( (VARI (I)  - X) * (VARI ( 1+1 ) - X))  61,61,40 
C IN  GIVES  DIRECTION  FOR  SEARCH  INTERVALS 

40  SIGN1  - 1.0 

IN  - SIGN(SIGN1, (VARI(I+1)  - VARI(I))*(X  - VARI(I))) 

C IF  X OUTSIDE  ENDPOINTS,  EXTRAPOLATE  FROM  END  INTERVAL 

41  IF  ((I+IN) .LE.O)  GO  TO  61 
IF  ((I+IN) .GE.N)  GO  TO  61 
I - I + IN 

IF  ((VARI (I)  - X)*(VARI(I+1)  - X))  61,61,41 
61  IF  (MA.EQ.2)  GO  TO  200 

C FIRST  ORDER 

Y - (VARD(I)*(VARI(I+1)  - X)  - VARD ( 1+1 ) * (VARI ( I ) - X))/ 

* (VARI (1+1)  - VARI (I)) 

GO  TO  800 

C SECOND  ORDER 

200  IF  (N.EQ.2)  GO  TO  2 

IF  (I.EQ.(N-l))  GO  TO  209 
IF  (I.EQ.l)  GO  TO  201 

C PICK  THIRD  POINT 

SK  - VARI (1+1)  - VARI (I) 

IF  ( (SK*(X  - VARI (I - 1) ) ) . LT. (SK* (VARI (1+2)  - X)))  GO  TO  209 

201  L - I 

GO  TO  702 
209  L - I - 1 
702  V(l)  - VARI (L)  - X 
V(2)  - VARI (L+l)  - X 
V(3)  - VARI (L+2 ) - X 

YY(1)  - (VARD(L)*V(2)-VARD(L+1)*V(1))/(VARI(L+1)-VARI(L)) 

YY(2)  - ( VARD ( L+l )*V(3) -VARD(L+2)*V(2) ) /(VARI (L+2) -VARI (L+l) ) 

Y - (YY(1)*V(3)  - YY (2)*V(1))/ (VARI (L+2)  - VARI(L)) 

800  II (LI)  - I 

RETURN 


s\0 


END 

C 



c 

SUBROUTINE  FOFTS23  (MAXI,TOLltTOL2,ICODE,TSG,IQI,IQ2,IQ3) 

C 

C CALLED  BY  MAIN  TO  EVALUATE  TS  BY  NEWTON  ITERATION  TECHNIQUE 
C 

IMPLICIT  REAL*8(A-H,0-Z) 

COMMON  /Al/  M , IX , IMAX , IPS I , MODEL , TE1 , TE2 
COMMON  /A2/  P(200) ,DPDX(200) ,VARI(200) 

COMMON  /A3/  EVIINF(25) ,THETAI(25) ,MUI(25) ,FI(25)  .DELHI (25) , 

* CIINF(25) ,LI(25) 

COMMON  /A4/  R.MUINF, DELTA .LAMSQ.OMEGSQ, OMEGA, MU, T,U, TINF 
COMMON  /A5/  EPSIIL(20 ,25) ,GIL(20,25) , CID(200 ,4) 

COMMON  /A6/  VAR(52) ,CUVAR(52) ,DER(51) 

DIMENSION  SUMGM(25) , EISM(25) , DEISM(25) 

REAL* 8 MUI , LAMSQ , MUINF , MU 
C 

W - 1.0 

DO  1 I - 1 , IMAX 

1 CID(IX.I)  - CIINF(I) 

ITER  - 0 

2 ITER  - ITER  + 1 

IF  (ITER.EQ.l)  THEN 
ES  - DELTA 

PS  - DSQRT(OMEGSQ  - 2 . *LAMSQ* ( DELTA  - ES)) 

ENDIF 

IF  (IQ1.EQ.1)  THEN 
TVIB  - TINF 
ELSE 

TVIB  - TSG 
ENDIF 

IF  (IQ2.EQ.1)  THEN 
TEL  - TINF 
ELSE 

TEL  - TSG 
ENDIF 
C 

ES  - 0.0 

DES  - 0.0 

DO  25  I - 1 , IMAX 

IF  (M.EQ.l)  EVIS  - EVIINF(I) 

IF  (M.EQ.l)  GO  TO  5 

TEM  - DEXP (THETAI ( I ) /TVIB) 

EVIS  - (R*THETAI (I) )/(MUI (I)*(TEM  - 1.0))*FI(I) 

DEVIS  - ( R*FI ( I ) *THETAI ( I ) **2 ) / (MUI ( I ) *TVIB**2 ) * (TEM/ (TEM- 1 . 0 ) **2 ) 
5 IF  (I.EQ.l)  QVN  - 1.0/(1.0  - DEXP ( -THETAI ( I )/TVIB) ) 

IF  (I.EQ.2)  QVO  - 1.0/(1.0  - DEXP( -THETAI (I)/TVIB) ) 

SUMGM(I)  - 0.0 
SUMGE  - 0.0 
DSUMGE  - 0.0 
LI I - LI (I) 

C 

DO  10  L - l.LII 

TEMI  - DEXP(-EPSIIL(L, I)/TEL) 

SUMGM(I)  - SUMGM(I)  + TEM1*GIL(L, I) 

SUMGE  - SUMGE  + TEM1*GIL(L, I)*EPSIIL(L, I) 

10  DSUMGE  = DSUMGE  + TEM1*GIL(L, I)*EPSIIL(L, I)**2 
QROTN  - TSG/5.8 


5a  * 


QROTO  - TSG/4.2 

EEIS  - (R/MUI (I) )*(SUMGE/SUMGM(I) ) 

DEEIS  - R/MUI(I)*(((SUMGM(I)*DSUMGE/TEL**2)  - (SUMGE/TEL)**2) 

* /SUMGM(I)**2) 

EISM(I)  - ( 1 . 5*R*TSG) /MUI ( I ) + (FI(I)*R*TSG)/MUI(I)  + EVIS  + EEIS 

* + DELHI ( I ) /MUI ( I ) 

DEISM(I)  - .1 . 5*R/MUI (I)  + FI(I)*R/MUI(I)  + DEVIS  + DEEIS 
CONTINUE 

BETA  FOR  OXYGEN 

IF  (IQ3.EQ.2)  THEN 
TD  - 59500.0 

FI  - CIINF ( 2 ) *MUINF/MUI ( 2 ) 

CIA  - TD/TSG 

CIA  - DEXP(ClA/2 . 0) 

C1B  - 8.8568195*(1.  - CIINF(1))*C1A*(1./(TSG**2.5)) 

Cl  - C1A*2 . 0*MUINF*PS*C1B*QVO*QROTO*(SUMGM(2)/(SUMGM(4)**2)  )/R 
BETAO  - ( (Fl-1. ) + DSQRT ( (1 . -Fl)**2  + 4 .*(F1+C1) ) )/(2 ,*(F1+C1) ) 

BETAN  - 0.0 
END  IF 

BETA  FOR  NITROGEN  AND  OXYGEN 

IF  (IQ3.EQ.3)  THEN 
BETAN  - .1 
BETAO  - 1.0 
TDN  - 113500.0 
TDO  - 59500.0 

FlA  - 8 . 8568195*(1.  - CIINF(l) )*DEXP(TDO/TSG)*(l ./(TSG**2 . 5) ) 

F2A  - 12.36681*(1.  - CIINF(2) )*DEXP(TDN/TSG)*(1 ,/(TSG**2 . 5) ) 

FI  - 2 . 0*MUINF*PS*F1A*QVO*QROTO*(SUMGM(2)/(SUMGM(4)**2)  )/R 
F2  - 2.0*MUINF*PS*F2A*QVN*QR0TN*(SUMGM(1)/(SUMGM(3)**2))/R 
A - ((1.  - BETAO**2)  + BETAN*(1.  - BETAO) )/(BETAO**2)  - FI 
B - ((1.  - BETAN**2)  + BETAO*(l.  - BETAN) )/(BETAN**2)  - F2 
ABO  - (BETAN*BETAO  - 2.*(1.  + BETAN) )/(BETAO**3) 

ABN  - (1.  - BETAO) /(BETAO**2) 

BBO  - (1.  - BETAN)/ (BETAN**2) 

BBN  - (BETAN*BETAO  - 2.*(1.  + BETAO) )/(BETAN**3) 

DEN  - ABO*BBN  - BBO*ABN 
DBO  - ( -A*BBN  + B*ABN)/DEN 
DBN  - ( - B*ABO  + A*BBO)/DEN 
BETAN  - BETAN  + DBN 
BETAO  - BETAO  + DBO 

IF  ( (DABS (DBO) .GT. .00001) .OR. (DABS (DBN) .GT. .00001))  GO  TO  30 
END  IF 

DISSOCIATING  CONCENTRATIONS  ACROSS  THE  SHOCK 
CID(IX, 2)  - (1.0  - BETAO)*CIINF(2) 

CID(IX,4)  - BETAO*CIINF(2) 

CID(IX,1)  - (1.0  - BETAN) *CIINF(1) 

CID(IX, 3)  - BETAN*CIINF(1) 

DO  35  I - l.IMAX 

ES  - ES  + EISM(I)*CID(IX,I) 

DES  - DES  + DEISM(I)*CID(IX,I) 

FAC  - DSQRT (OMEGSQ  - 2 . 0*LAMSQ* (DELTA  - ES)) 

FIN  - ( 2 . 0*MUINF* ( DELTA  - ES)*FAC)/(R* (OMEGA  + FAC)) 

FTS  - TSG  - FIN 

FAC1  = R*  ( OMEGA+FAC ) * (MUINF*  (DELTA - ES  ) * ( 2 . 0/FAC ) *LAMSQ*DES  - 

* 2 . 0*FAC*MUINF*DES ) - 2 . 0*MUINF* (DELTA- ES)*R*LAMSQ*DES 
FAC2  - R**2* (OMEGA  + FAC)**2 

DFTS  - 1.0  - (FAC1/FAC2) 

PS  - FAC 

IF  (DFTS. EQ. 0.0)  THEN 


I CODE  - 2 
RETURN 
ENDIF 

TSG1  - TSG  - W*(FTS/DFTS) 

DELTS  - DABS (TSG1  - TSG) 

TSG  - TSG1 

IF  ( ITER. GE. MAXI)  THEN 
ICODE  - 1 
RETURN 
ENDIF 

IF  ( DELTS. GT.TOL1)  THEN 
ITER1  - ITER 
GO  TO  2 
ENDIF 

ITER2-ITER1+10 

I F ( DELTS . LE . TOL2 . OR . ITER . GE . ITER2 ) RETURN 

GO  TO  2 

END 


STATMENT  LISTING  OF  PROGRAM  RADNWi.FOR 
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C PROGRAM  FOR  COMPUTING  THE  RADIATIVE  HEAT  TRANSFER  AT  THE  BODY  SURFACE 
C IN  A HYPERSONIC  FLOWFIELD.  THIS  PROGRAM  IS  USED  IN  CONJUNCTION  WITH 
C AFE2 . FOR 
C THIS  IS  RADMTE . FOR 

C RADIATION  MODELS  1)  OLSTAD  MODEL 

C 2)  CARLSON  MODEL 

C 

IMPLICIT  REAL*8(A-H,0-Z) 

COMMON  /A9/  MUI(25) ,XPST(30) 

COMMON  /RAD/  NXCON, NPTS (30) .TSTAG , LI (25) , IMAX 
COMMON  /RADI/  RRHO(30, 30) ,Y(30, 30) ,YBDY(30) 

COMMON  /RAD2/  RC0N(30 , 10 , 30) 

COMMON  /RAD3/  B(30,8,30) 

COMMON  /RAD5/  0PTL(30 , 8 , 30) 

COMMON  /RAD6/  ALPN(30 , 30) , ALPO(30 , 30) , BETN(30 , 30) , BET0(30 , 30) 

COMMON  /RAD7/  TEMP0(30 , 30) ,TEMP(30 , 30) 

COMMON  /RAD8/  KAP(30,4,30) 

COMMON  /RAD9/  KAPPA(30 , 8 , 30) ,KA(30 , 4 , 30) 

COMMON  /RADIO/  EPSIIL(20 , 25) , GIL(20 , 25) 

REAL  OPTL,XPST,Y,YBDY, TEMPO, TEMP, Z 
REAL  ALPN , ALPO , B , BETN , BETO 
REAL* 8 KAPPA ,KAP,KA,MUI , EPSIIL, GIL 
CHARACTER*30  OUTFIL 

C OPEN  RADIATION  INPUT  FILES  ( AFE2 . FOR) 

OPEN  (UNIT-15,  FILE- 'RADIN1.DAT' , STATUS- ' OLD  ' ) 

OPEN  (UNIT-16, FILE- 'RADIN2.DAT' , STATUS- ' OLD ' ) 

OPEN  (UNIT-17 . FILE- ' RADIN3 . DAT ' , STATUS- ' OLD ' ) 

C READ  INPUT 

READ (15,1)  OUTFIL 

1 FORMAT (A3 0) 

READ(15 ,*)  MODEL, IQ3 .VINF.TINF, PINF 
READ ( 15 , *)  NXPST , NXCON , IMAX , IQ4 , IQ5 , IQ6 , IQ8 , IQ9 , IQ10 
IF  (NXCON. GT. 30)  THEN 
WRITE(* ,2)  NXCON 

2 FORMAT (IX, 'NXCON  - ',13,'  MAX  - 30  STRLNES  IN  RAD. FOR') 

STOP 

ENDIF 

IF  (IQ4.EQ.0)  GO  TO  60 

OPEN  (UNIT-8  , FILE-OUTFIL,  STATUS- 'UNKNOWN'  ) 

DO  5 I - 1 , IMAX 
5 READ(15 , *)  MUI(I) 

DO  7 I - 1 , IMAX 
READ(15 , *)  LI I 
LI  (I)  - LI  I 

7 READ(15 ,*)  (GIL(L,I),L  - l.LII) 

DO  9 I - 1 , IMAX 
READ(15 ,*)  LI I 

9 READ(15 ,*)  (EPSIIL(L.I) ,L  - l.LII) 

DO  10  I - 1, NXPST 
10  READ(15 ,*)  NPTS ( I ) , XPST ( I ) 

READ (15,*)  TSTAG 
READ (15,*)  KSTAG 
DO  15  I - 1, KSTAG 
READ(16 ,*)  LPS2.JJJ 
IF  (IMAX.EQ.7)  THEN 

READ(16 , *)  RCON(LPS2 , 1 , JJJ) ,RC0N(LPS2 , 2 , JJJ) ,RCON(LPS2 , 3 , JJJ) , 

* RCON (LPS2,4,JJJ) , RCON(LPS2 , 5 , JJJ) ,RCON(LPS2 , 6 , JJJ) , 

* RCON(LPS2 , 7 , JJJ) ,RRHO(LPS2,JJJ) ,TEMP(LPS2, JJJ) , 

* TEMPO(LPS2 , JJJ) 

ENDIF 





IF  (IMAX.EQ.10)  THEN 

READ(16,*)  RCON(LPS2 , 1 , JJJ) ,RCON(LPS2 , 2 , JJJ) ,RCON(LPS2 , 3 , JJJ)  , 

* RCON(LPS2,4,JJJ) ,RCON(LPS2 , 5 , JJJ) ,RCON(LPS2,6,JJJ)  , 

* RCON(LPS2 , 7 , JJJ)  ,RCON(LPS2 , 8 , JJJ)  ,RCON(LPS2,9,JJJ)  , 

* RCON(LPS2 , 10 , JJJ) ,RRH0(LPS2 , JJJ) , TEMP (LPS2, JJJ) , 

* TEMP0(LPS2 , JJJ) 

END  IF 

15  CONTINUE 

19  READ (17,*, END-21)  IBOB.IK 
READ (17,*)  YBDY(IBOB) 

DO  20  J - 2, IK 

20  READ(17 ,*)  Y(IBOB.J-l) 

GO  TO  19 

c INITIAL  CONDITIONS 

21  WRITE(*,22)  VINF, PINF.TINF 
WRITE(8 , 22)  VINF, PINF.TINF 

22  FORMAT  ( IX,  ' FREE  STREAM  QUANTITIES  : ' ,//,lX,  'VINF  - '.E12.5.1X, 

* 'cm/sec'  ,/, IX,  'PINF  - ' .E12.5.1X,  ' dynes/cm/>2 ' ,/,lX, 

* 'TINF  - ' ,E12.5,1X, 'K'///) 

WRITE (*,23)  MODEL 

WRITE (8, 23)  MODEL 

23  F0RMAT(1X, 'VIBRATION -DISSOCIATION  COUPLING  MODELS ',//, 12X, 

* 'TYPE'  ,11X,  'NO.  ' ,//,9X,  'VIB.  EQUIL.  ' , 8X, ' 0 ' ,/ , 12X, ' CVD' , 13X, 

* '1' ,/,12X, ' CVDV ' , 12X,  '2' ,/,6X,  ’ CVDV- Preferential' ,5X, '3' ,/, 

* 12X, 'PARK' ,12X, '4' , ' - ',13///) 

WRITE(* , 24)  IQ3 

WRITE (8, 24)  IQ3 

24  FORMAT (7X, 'SHOCK  JUMP  CONDITION  MODELS ',//, 12X, 

* 'TYPE' ,11X, 'NO. ' ,//,6X, 'CHEMISTRY  FROZEN' , 6X, ' 1 ',/, 5X, 

* 'N2  FROZEN,  02  DISS . ' ,4X, ' 2 ' ,/, 7X, 'N2  AND  02  DISS.',6X, 

* '3','  - ' ,13///) 

C RADIATION  MODELS 

IF  (IQ4.EQ.1)  CALL  OLRAD  (IQ5 , IQ6 , IQ8 , IQ9 , IQ10) 

C IF  (IQ4.EQ.2)  CALL  CARLRAD  (IQ4 , IQ5 , IQ9) 

IF  ((IQ4.EQ.3) .OR. (IQ4.EQ.4))  THEN 
CALL  OLRAD  (IQ5 , IQ6 , IQ8 , IQ9 , IQ10) 

C CALL  CARLRAD  (IQ4 , IQ5 , IQ9) 

END  IF 

IF  (IQ4.EQ.4)  THEN 
C IF  (IQ5.EQ.0)THEN 

DO  1920  K-3,  NXCON 
WRITE(8 ,30)XPST(K) 

DO  1920  J— 1 , NPTS (K) 

WRITE (8 , 1921)  J , ALPN(K,  J)  ,ALPO(K,  J)  ,BETN(K,  J)  ,BETO(K,  J) 

1921  FORMAT ( ' J-',I2,'  An-', Dll. 4,'  Ao-',D11.4/ 

* ' ' , 2X, ' BN-', Dll. 4,'  BO-', Dll. 4) 

1920  CONTINUE 

C ENDIF 

DO  40  K - 3, NXCON 
WRITE(* , 30)  XPST(K) 

WRITE(8 , 30)  XPST(K) 

30  FORMAT (///, 'AT  X - ',D11.4,///) 

DO  40  J - 1 , NPTS (K) 

WRITE(*,35)  J ,TEMP(K, J) ,RRHO(K,J) ,TEMPO(K,J) 

WRITE(8 , 35)  J ,TEMP(K, J) ,RRHO(K,J) ,TEMPO(K,J) 

35  FORMAT ( ' J = ’,12,'  TVN2  - '.F10.2,'  RHO  - '.D11.4,'  T-',F10.2) 
40  CONTINUE 

DO  55  K - 3, NXCON 
WRITE(8 , 30)  XPST(K) 

DO  55  J - 1 , NPTS (K) 
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WRITE (8 ,45)  J 

45  FORMAT  (/,  ' AT  J - ',12,'  THE  NUMBER  DENSITIES  ARE  ' ,/) 
DO  55  I - l.IMAX 
WRITE(8 , 50)  I ,RCON(K, I , J) 

50  FORMAT ( ' SPECIES  - ',12/  N - ' .D11.4) 

55  CONTINUE 
ENDIF 
CLOSE (8) 

60  CLOSE(15) 

CLOSE(16) 

CLOSE(17) 

STOP 

END 


SUBROUTINE  OLRAD  (IQS , IQ6 , IQ8 , IQ9 , IQ10) 

IMPLICIT  REAL*8(A-H,0-Z) 

COMMON  /A9/  MUI(25) ,XPST(30) 

COMMON  /RAD/  NXCON,NPTS(30) ,TSTAG,LI(25)  ,IMAX 
COMMON  /RADI/  RRHO(30 ,30) , Y(30 , 30) , YBDY(30) 

COMMON  /RAD2/  RCON(30, 10, 30) 

COMMON  /RAD3/  B(30 , 8 , 30) 

COMMON  /RAD5/  OPTL(30 , 8 , 30) 

COMMON  /RAD6/  ALPN(30 , 30) , ALPO(30 , 30) , BETN(30 , 30) , BETO(30 , 30) 
COMMON  /RAD7/  TEMPO(30 , 30) ,TEMP(30 , 30) 

COMMON  /RAD8/  KAP(30,4,30) 

COMMON  /RAD9/  KAPPA(30 , 8 , 30) ,KA(30 ,4 , 30) 

COMMON  /RADIO/  EPSIIL(20 , 25) , GIL(20 , 25) 

REAL  OPTL, XPST.Y.YBDY, TEMPO, TEMP, Z 
REAL  ALPN , ALPO , B , BETN , BETO , EPSIIL, GIL 
REAL* 8 K11,K22,N,NN, KAPPA, KAP.KA.MUI 
REAL* 8 A(4 ,5) 

WRITE (8 ,1) 

1 FORMAT (///'  OLSTAD  RADIATION  MODEL') 

IF(IQ8 . EQ. 0)  THEN 

IF(IQ6.EQ.0)  WRITE (8 ,2) 

IF(IQ6 . EQ. 1)  WRITE(8 , 3) 

ENDIF 

2 FORMAT (/'  BETA-BETA(Te) ’ ) 

3 FORMAT (/'  BETA-BETA(Tt) ' ) 

C NUMBER  DENSITIES 

DO  12  K-3.NXCON 
DO  12  J-l , NPTS (K) 

DO  10  II-l.IMAX 
XXX-RRHO (K , J ) *6 . 02 3D+2 3 
XXX-XXX*RCON(K, II , J)/MUI (II) 

10  RCON(K,II,J)-XXX 
12  CONTINUE 

IF(IQ10 . EQ. 0)GO  TO  15 

C ELECTRON  TEMPERATURE 

DO  14  K~3 , NXCON 
NUP-NPTS (K) -1 
DO  14  J-l.NUP 
T-TEMPO(K.J) 

FNA-RCON ( K , 3 , J ) 

FNI-RCON (K , 9 , J ) 

FNE=RCON (K , 7 , J ) 

FNM-RCON (K , 1 , J ) 


FOA-RCON (K , 4 , J ) 

FOI-RCON (K , 10 , J ) 

ITRTE-0 

FOM-RCON (K , 2 , J ) 

EI-2 . 3322D-11 

FAV-6.023D23 

EO-2 . 173D-11 

SA-1.52D-15 

Fl-0 

F2-0 

FO-O 

574  ITRTE-ITRTE+1 

IF(ITRTE.GT. l)GO  TO  571 
KK-1 

569  KK-KK+1 

IF(KK.GT. 50 ) TEMP (K,J) -2000 
IF(KK.GT.50)GO  TO  14 
TE-1000*KK 

571  SM-0. 5355D-19*TE+. 696D-15 
IF(ITRTE.GT. 50) GO  TO  573 
SI-1 . 53614D08*(TE**3)/FNE 
SI— DSQRT(SI) 

SI— (4 . 38384D-06/(TE**2) )*DLOG(SI) 

FKF-4 . 16D13*(TE**(  0 . 50D0) )*DEXP( -1 . 20D05/TE) 

FK1-5 . 49D13*(TE**(  0 . 50D0) )*DEXP( -1 . 045D05/TE) 

FKB-2 . 3D21*(TE**( -1 . 0D00) )*DEXP(4 . 9D4/TE) 

FK5-1 . 5 3D22* ( TE** ( - 1 . 0D0 ) ) *DEXP ( 5 . 3D4/TE) 

WEA-FKF*FNA- FKB* ( FNI/FAV)*FNE 
W2E-FK1*F0A - FK5* ( FOI/FAV) *FNE 

SX-  ( FNA+FOA)  *SA+  ( FNI+FOI ) *S  1+  ( FNH+FOM)  /2 . 0D0*SM 
Wl— WEA+W2E 

FE-T- 1 . 23357D- 10/SX/DSQRT (TE)  * (WEA*EI+W2E*E0+W1*3 . 45D-  16*TE)  -TE 

IF(ITRTE.GT. l)GO  TO  568 

IF( (FE/DABS (FE)*F0) . LT . 0 . DOO)GO  TO  567 

FO-FE 

TO-TE 

GO  TO  569 

567  Fl-FE 
Tl-TE 

566  TE- ( T0*F1 -T1*F0)/(F1-F0) 

IF(DABS(TE-T1).LT.1.DOO)GO  TO  573 
IF (DABS (TE-TO) . LT . 1 . DOO)GO  TO  573 
GO  TO  574 

568  IF( (FE/DABS (FE)*F0/DABS (FO) ) . LT . 0 . ODOO)GO  TO  564 
TO-TE 

FO-FE 
GO  TO  566 
564  Fl-FE 
Tl-TE 
GO  TO  566 

573  IF(TE.GT.T)TE=T 

IF(ITRTE.GT. 50 ) WRITE (*, 572) 

IF(ITRTE.GT. 50)WRITE(8 , 572) 

572  FORMAT ( ' ' , 'TE  DID  NOT  CONVERGE') 

TEMP(K,J)-TE 

14  CONTINUE 

15  CONTINUE 

NONEQUILIBRIUM  RADIATION  CORRECTION 

IF  (IQ5.EQ.0)  THEN 
DO  122  K— 3 , NXCON 


DO  122  J-l.NPTS(K) 

IF(J.EQ.NPTS(K))  THEN 
ALPN(K,J)— O.D+OO 
ALPO(K,J)-0.D+00 
BETO(K,J)-0.D+00 
BETN(K,J)-0.D+00 
GO  TO  122 
ENDIF 
Q1N-0 . D+O 
Q2N-0.D+0 
Q3N-0.D+0 
DO  112  III-1,LI(3) 

112  Q1N-Q1N+GIL(III,3)*DEXP(-EPSIIL(III,3)/TEMP(K,J)) 

DO  113  III-l ,LI(9) 

113  Q2N-Q2N+GIL(III , 9)*DEXP(  -EPSIIL(III , 9)/TEMP(K,  J)  ) 

DO  130  111-1,11(1) 

130  Q3N-Q3N+GIL(III , 1)*DEXP(  -EPSIIL(III , 1)/TEMP(K,  J)  ) 

RH01-RC0N (K , 3 , J)*l . 401D+01/6 . 023D+23 
RH02-RC0N ( K , 9 , J ) *1 . 401D+01/6 . 023D+23 
RH03-RC0N (K , 1 , J ) *2 . 802D+01/6 . 023D+23 
RH04N-RH01+RH02+RH03 

QVIBN-1 . D+O/ ( 1 . D+O - DEXP ( - 3 . 39D+03/TEMP (K , J) ) ) 

QROTN-TEMP (K, J)/5 . 8D+0 

Q10-0 . D+O 

Q20-0 . D+O 

Q3O-0.D+0 

DO  152  III-1,LI(4) 

152  Q10— Q10+GIL(I11 , 4)*EXP( -EPSIIL(III , 4) /TEMP (K,  J) ) 

DO  153  III-l ,LI(10) 

153  Q20-Q20+GIL(III , 10)*DEXP(-EPSIIL(III , 10)/TEMP(K, J) ) 

DO  160  III-l, LI(2) 

160  Q30-Q30+GIL(III,2)*DEXP(-EPSIIL(III,2)/TEMP(K,J)) 

RH01-RC0N (K , 4 , J ) *1 . 600D+01/6 . 023D+23 
RH02-RC0N(K, 10 , J)*l. 600D+01/6 .023D+23 
RH03— RCON(K, 2 , J)*3 . 200D+01/6 . 023D+23 
RH040— RH01+RH02+RH03 

QVIBO-1 . D+O/ ( 1 . D+O - DEXP ( - 2 . 27D+03/TEMP (K,  J) ) ) 

QROTO-TEHP (K, J)/4 . 2D+0 
C ALPHAN-0 . 5 D+O 

C BETAN-0 . 5 D+O 

C ALPHAO-O . 5 D+O 

C BETAO-O . 5 D+O 

Cl-2 . 4701D01*RH04N*QVIBN*QROTN*Q3N*DEXP ( 1 . 135D+05/TEMP (K , J ) ) 
Cl-Cl/ (Q1N**2*TEMP (K , J ) **1 . 5 ) 

C2-1 . 7 7 2 5D+01*RHO40*QVIBO*QROTO*Q30*DEXP ( 5 . 9 5 0D+04/TEMP (K , J ) ) 
C2-C2 / (Q10**2*TEMP (K , J ) **1 . 5 ) 

C C3-RH04N*8 . 909D+06*Q1N*DEXP ( 1 . 69D+05/TEMP (K , J) ) 

C C3-C3/(Q2N*TEMP(K,J)**1.5) 

C C4— C 3*RH040 /RH04N+0 . 875625D+0 

C C5-RH040*7 . 801D+06*Q10*DEXP(1 . 58D+05/TEMP(K, J) ) 

C C5— C5/(Q20*TEMP(K, J)**l . 5) 

C C6— C5*RH04N/RH040*1 . 142D+0 

C ITAB-0 

C 132  ITAB-ITAB+1 
C IF(ITAB.LT. 51) GO  TO  133 

C WRITE (* , 1331)K, J 

C WRITE (8 , 1331)K, J 

C1331  FORMAT ( ' ','CORR  FAC  FAILED  TO  CONVERGE' , 215) 

C GO  TO  127 

C 133  A(1,5)=-(B  ETAN**  2* ( 1 . D+O - ALPHAN ) ** 2*C 1+BETAN - 1 . D+O ) 
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C A ( 3 , 5 ) — ( BETA0**2*  ( 1 . D+O  - ALPHAO  ) **2*C2+BETA0  - 1 . D+O  ) 

C A(2 , 5)—  (BETAN*ALPHAN**2*C3+C4*ALPHAN*BETAO*ALPHAO+ALPHAN- 1 . D+O) 

C A(4 , 5 )—  ( C5*BETAO*ALPHAO**2+C6*BETAN*ALPHAN*ALPHAO+ALPHAO - 1 . D+O) 

C A(1 , 1)—  ( 2 . D+O  ) * ( 1 . D+O  - ALPHAN ) *BETAN**2 

C A ( 1 , 2 ) - ( 2 . D+O ) *BETAN* ( 1 . D+O -ALPHAN) **2+1 . D+O 

C A(l,3)-0.0D+00. 

C A(l,4)-0.0D+00 

C A(2 , l)-(2 . D+0)*C3*ALPHAN*BETAN+C4*BETAO*ALPHAO+1 . D+O 

C A(2 , 2)-C3*ALPHAN**2 

C A ( 2 , 3 ) -C4*ALPHAN*BETA0 

C A ( 2 , 4 ) -C4*ALPHAN*ALPHA0 

C A(3 , l)-0 .D+OO 

C A(3 , 2)-0. D+OO 

C a ( 3 , 3 ) — ( 2 . D+O ) * ( 1 . D+O - ALPHAO ) *BETAO** 2 

C A ( 3 , 4 ) - ( 2 . D+O ) *BETAO* ( 1 . D+O -ALPHAO) **2+1 . D+O 

C A(4 , 1)— C6*BETAN*ALPHAO 

C A(4 , 2)— C6*ALPHAN*ALPHAO 

C A(4 , 3 )-(2  . D+0)*C5*BETAO*ALPHAO+C6*BETAN*ALPHAN+1 . D+O 

C A(4,4)-C5*ALPHAO**2 

C DO  121  1-1,4 

C II-I+l 

C DO  125  JJ-11,5 

C 125  A(I , JJ)-A(I ,JJ)/A(I,I) 

C DO  123  KK-1,4 

C IF(KK.EQ.I)GO  TO  123 

C DO  124  JJ-11,5 

C 124  A(KK, JJ)— A(KK, JJ) -A(KK, I)*A(I,JJ) 

C 123  CONTINUE 
C 121  CONTINUE 
C ALPHAN-ALPHAN+A (1,5) 

C BETAN-BETAN+A (2,5) 

C ALPHAO-ALPHAO+A (3,5) 

C BETAO-BETAO+A (4,5) 

C DO  126  1-1,4 

C IF  (DABS (A (I, 5)) .GT.1.D-05)GO  TO  132 

C 126  CONTINUE 

C 127  ALPHN-RCON(K, 9 , J)/(RCON(K, 9 , J)+RCON(K, 3 , J) ) 

C BETl-(RCON(K, 9 , J )+RCON(K,  3 , J) )/(2 . D+0*RC0N (K, 1 , J)  + 

C * RCON(K, 9 , J)+RCON(K, 3 , J) ) 

C WRITE(8 , 1271)K, J , ALPHAN, BETAN,ALPHN,BET1 

C1271  FORMAT ( ' ' , 215 , 4E12 . 4) 

ALPHO-RCON ( K , 10 , J ) / ( RCON ( K , 10 , J ) +RCON (K , 4 , J ) ) 

BET2— (RCON(K,10,J) +RCON (K,4,J))/(2. D+O+RCON ( K , 2 , J ) + 

RCON(K, 10 , J)+RCON(K, 4 , J) ) 

C WRITE (8 , 1271)K, J , ALPHAO , BETAO , ALPHO , BET2 

C BETN(K, J)-(BET1**2/(1 . D+0-BET1) )*( (1 . D+0-BETAN)/(BETAN**2) 

C * *( (1 . D+O -ALPHN) **2/(1. D+O - ALPHAN) **2) 

BETN(K, J)— (RCON(K, 3 , J)/RCON(K, 1 , J) )*RCON(K, 3 , J)*C1*1. 162D-23 

* /RH04N 

C C7-RH040/RH04N*0 . 875625D+0 

C C8-BET2/BET1*ALPH0/ALPHN 

C C 9 -BETAO/B  ETAN*ALPHAO / ALPHAN 

C 1 8 8 8 ALPN ( K , J ) -B  Ef 1* ( ALPHN**2 / ( 1 . D+O - ALPHN ) ) 

C * *( (1 . D+O -ALPHAN) /(BETAN*ALPHAN**2) ) 

C * *(l.D+0+C7*C8)/(l.D+0+C7*C9) 

ALPN (K , J ) -RCON (K , 9 , J) /RCON (K , 3 , J) *RCON(K , 7 , J) *Q1N/Q2N* 

* DEXP(1 . 69D+05/TEMP(K, J) )/(4 . 826D+15*TEMP(K, J)**l . 5) 

C BETO (K , J ) - ( BET2**2/ ( 1 . D+O - BET2 ) ) * ( ( 1 . D+O - BETAO ) / ( BETAO**2 ) 

C * *((1.D+0-ALPHO)**2/(1.D+0-ALPHAO)**2) 

BETO(K, J)— (RCON(K, 4 , J) /RCON (K , 2 , J) )*RCON(K, 4 , J)*C2*1 . 328D- 23 


o o 


* /RH040 

C1999  ALPO ( K , J ) -BET2* ( ALPHO**2/ ( 1 . 0+0 - ALPHO ) ) 

C * *( (l.D+0-ALPHAO)/(BETAO*ALPHAO**2)) 

C * * ( 1 . D+O+l . D+0/C7/C8 )/ ( 1 . D+O+l . D+0/C7/C9 ) 

ALPO(K, J ) — RCON (K , 10 , J ) /RCON (K , 4 , J ) *RCON(K , 7 , J ) +Q10/Q20* 

* DEXP(1.575D+05/TEMP(K,J))/(4.826D+15*TEMP(K,J)**1.5) 
122  CONTINUE 

C ENDIF 

C ABSORPTION  COEFFICIENTS 

DO  20  K-3 , NXCON 
DO  20  J-1,NPTS(K) 

TT-TEMP(K,J)/168800.0 
IF(IQ6.EQ.l)  THEN 

TM-TEMPO(K, J)/168800.0 
ELSE 
TM-TT 
ENDIF 

C IF((IQ6.EQ.l) .AND. (TEMPO(K,J) .LE.8.D+03))  GO  TO  20 

C IF(TEMP(K,J) .LE.8.D+03)  GO  TO  20 

IF(IQ8 . EQ. 0)  THEN 
O-BETO(K.J) 

N-BETN(K.J) 

ELSE 

0-1 . D+0 
N-l . D+0 
ENDIF 

KAPPA ( K , 4 , J ) -5 . D - 1 9*0*RC0N (K,2,J)+5.D- 20*N*RCON (K , 1 , J ) 

KAP (K, 4 , J)— 1 . 7D- 17+RCON (K , 3 , J ) *DEXP ( - . 246/TT) 

KA(K,4, J)— 0.D+0 

KAPPA(K,  3 , J)-2 .D-18*(N*RCON(K, 1 , J)+0*RC0N(K, 2 , J)  )+KAPPA(K,4 , J) 
KAP(K,  3 , J)— 2 . ID  - 17*RC0N(K,  3 , J)*DEXP( • . 165/TT)+KAP(K,4 , J) 
KA(K,3,J)-0.D+0 

KAPPA(K,  2 , J)-5 . 1D-18*(N*RC0N(K,  1 , J)+0*RC0N(K,  2 , J)  )+KAPPA(K,  3 , J) 
KAP(K, 2 , J)-KAP(K, 3 , J) 

KA(K, 2 , J)-5 . 1D-18*RC0N(K, 4 , J) 

KAPPA (K, 1 , J)-2 . D- 17*0*RC0N(K, 2 , J)+4 . D- 16*N*RCON(K, 1 , J) 

C +KAPPA(K, 2 , J) 

KAP(K, 1 , J)-l . ID- 17*RCON(K, 3 , J)+KAP(K, 2 , J) 

KA(K, 1 , J)— KA(K, 2 , J) 

IF(IQ5 . EQ . 0)  THEN 
N-ALPN(K.J) 

O-ALPO(K.J) 

ELSE 
N-l. D+0 
0-1 . D+0 
ALPN(K,J)-N 
ALPO(K, J)— 0 
ENDIF 

IF(IQ8 . EQ . 0)  THEN 
NN-BETN(K.J) 

OO-BETO(K.J) 

ELSE 

NN-1 . D+0 
. 00-1. D+0 
BETN(K,J)-NN 
BETO(K, J)— 00 
ENDIF 

KAPPA (K, 5 , J )-7 . 7D- 17*(NN*RC0N(K, 1 , J)+00*RC0N (K, 2 , J) ) 

*DEXP( - ,49/TT)+ 

2.6D-17*(RC0N(K,3,J)*N+RC0N(K,4,J)*0)*DEXP(- ,723/TT) 


KAPPA(K,  6 , J)— 2 . D-18*RC0N(K,  2 , J)*00+6 . 0D-18*(RC0N(K,  3 , J)*N+ 

C RC0N(K,4,J)*0)*DEXP(-.379/TT)+KAPPA(K,5,J) 

IF(RC0N(K,7,J) .LE.l.D+OO)  THEN 
KAPPA(K , 7 , J )-KAPPA(K , 6 , J ) 

GO  TO  909 
END  IF 

KAPPA(K,  7 , J)-l . 2D03*(  (RCON(K,  3 , J)*N+RC0N(K,4 , J)*0) /RCON(K,  7 , J)  )* 
C DEXP( - . 489/TT)+KAPPA(K, 6 , J) 

909  KAPPA(K,  8 , J)-3 . 2D  - 17*(RCON(K,  3 , J)*N+RC0N(K,4 , J)*0)*DEXP( - . 631/TT) 
C +KAPPA(K, 5 , J) 

C ELSE 

C KAPPA(K,  5 , J)-7 . 7D-I7*(RC0N(K,  I,  J)+RC0N(K, 2 , J)  )*DEXP(-  .49/TT)+ 

C C 2 . 6D-17*(RCON(K, 3 , J)+RC0N(K,4 , J) )*DEXP( - . 723/TT) 

C KAPPA (K,  6 , J)-2  . D-18*RCON(K,  2 , J)+6 . OD-18*(RCON(K,  3 , J)+RCON(K,  4 , J)  ) 

C C *DEXP( - . 379/TT)+KAPPA(K, 5 , J) 

C IF(RCON(K, 7, J) .LE.l.D+OO)  THEN 

C KAPPA (K, 7 , J)— KAPPA (K, 6 , J) 

C GO  TO  910 

C END IF 

C KAPPA (K,  7 , J)-l . 2D03*(  (RCON(K,  3 , J)+RCON(K, 4 , J) ) /RCON(K,  7 , J)  )* 

C C DEXP( - .489/TT)+KAPPA(K, 6 , J) 

C 910  KAPPA (K, 8 , J)-3 . 2D-17*(RCON (K,  3 , J)+RCON(K, 4 , J) )*DEXP( - . 631/TT) 

C C +KAPPA(K, 5 , J) 

C END IF 

20  CONTINUE 

C PLANCK  FUNCTION 

DO  30  K-3 , NXCON 
DO  30  J-l.NPTS(K) 

TT— TEMP(K, J) /168800 . 0 
C IF(TEMP(K,J) .LE.8.D+03)  GO  TO  30 

BLACK— (TT*168800 . )**4*5 . 6696D-12/3 . 1415927 
FF-15 ,D+00/(3 . 1415927**4) 

XI— 1 . /TT 

Bl-FF* (DEXP ( -XI ) * ( 6 . +6 . *Xl+3 . *X1**2+X1**3 ) + 

C DEXP ( - 2 . *X1 ) *0 . 5* ( . 7 5+1 . 5*X1+1 . 5*X1**2+X1**3 ) ) 

Xl-0 . 935/TT 

B2-FF* ( DEXP ( -XI ) * ( 6 . +6 . *Xl+3 . *X1**2+X1**3 ) + 

C DEXP ( - 2 . *X1 ) *0 . 5* ( . 75+1 . 5*X1+1 . 5*X1**2+X1**3 ) ) 

Xl-0 . 835/TT 

B3-FF* (DEXP ( -XI ) * ( 6 . +6 . *Xl+3 . *X1**2+X1**3 ) + 

C DEXP ( - 2 . *X1 ) *0 . 5* ( . 7 5+1 . 5*X1+1 . 5*X1**2+X1**3 ) ) 

Xl-0 . 754/TT 

B4-FF* ( DEXP ( - XI ) * ( 6 . +6 . *Xl+3 . *X1**2+X1**3 ) + 

C DEXP ( - 2 . *X1 ) *0 . 5* ( . 7 5+1 . 5*X1+1 . 5*X1**2+X1**3 ) ) 

XI— 0 . 473/TT 

B6-FF*  ( DEXP  ( - XI ) * ( 6 . +6  . *Xl+3  . *X1**2+X1**3 ) + 

C DEXP( -2 . *X1)*0 . 5*( . 75+1 . 5*X1+1 . 5*X1**2+X1**3) ) 

Xl-0 . 213/TT 

B8-FF* (DEXP ( - XI ) * ( 6 . +6 . *Xl+3 . *X1**2+X1**3 ) + 

C DEXP ( - 2 . *X1 ) *0 . 5* ( . 7 5+1 . 5*X1+1 . 5*X1**2+X1**3 ) ) 

B8-1-B8 

B2-B2-B1 

B3-B3-B2 

B4-B4-B3 

B6-B6-B4 

B5-1-B8-B6-B4-B3-B2-B1 
B(K,1,J)“BLACK*B1 
B(K, 2 , J)-BLACK*B2 
B(K, 3 , J)-BLACK*B3 
B(K, 4 , J)— BLACK*B4 


B(K, 6, J)-BLACK*B6 

B ( K , 7 , J ) -BLACK*2 . 4D - 2 1*RC0N (K, 7 , J) *B6*DEXP ( . 16  2/TT) 

B(K, 8 , J)-BLACK*B8 
B(K, 5 , J)— BLACK*B5 
30  CONTINUE 

C TAU'S 

DO  100  K— 3 , NXCON 
DO  100  1-1,8 
IF(I.GT.4)  THEN 

OPTL(K, 1 , 1)-KAPPA(K, 1 , 1)*DABS (Y(K, 1) -YBDY(K)  ) 

ELSE 

OPTL(K, I , 1)— (KAPPA(K, I , 1)+KAP(K, I , 1)+KA(K, I , 1) ) 

C *DABS(Y(K, 1) -YBDY(K) ) 

END  IF 

DO  100  J— 2 ,NPTS (K) 

IF(I.GT.4)  THEN 

Kll— KAPPA ( K , I , J)+KAPPA(K, I , J-l) 

ELSE 

K11-KAPPA(K, I , J)+KAP(K, I , J)+KAPPA(K, I , J-1)+KAP(K, I , J-l) 
C +KA(K, I , J)+KA(K, I , J-l) 

END  IF 

OPTL(K, I , J)— OPTL(K, I , J-l)+(5 . D-1*(K11)*DABS (Y(K, J-l) 

C *Y(K, J) ) ) 

100  CONTINUE 

C QRW 

DO  200  K-3, NXCON 
WRITE(*, 102)  XPST(K) 

WRITE (8 , 102)  XPST(K) 

102  FORMAT(///, ' AT  X - ' ,D11.4) 

WQR-0.0 
DO  180  1-1,8 

CALL  FEI (Ell , E2I , E3I ,OPTL(K, I , 1) ) 

EOLD-E2I 

JIN-1 

IF(I.GT.4)  THEN 

Kll— KAPPA(K, I , 1)*B(K, I , 1) 

ELSE 

IF(IQ5 . EQ. 1)  THEN 
ALPN(K, 1)— 1.D+0 
ALPO ( K , 1 ) -1 . D+0 
END  IF 

Kll— KAPPA (K, I , 1)*B (K, I , 1)+KAP(K, I , 1)*B(K, I , 1)*ALPN(K, 1)+ 
C KA(K,I,1)*B(K,I, l)*ALPO(K, 1) 

END  IF 

SUM-3 . 1415927*E0LD*K11*DABS (Y(K, 1) -YBDY(K) ) 

IF(IQ9 . EQ. 0)  WRITE(8 , 2221)  JIN, I, SUM 
DO  150  J-2,NPTS(K) 

IF(I.GT.4)  THEN 

Kll— KAPPA (K, I , J)*B(K, I , J) 

K2 2-KAPPA (K, I,J-1)*B(K,I,J-1) 

ELSE 

IF(IQ5 . EQ. 1)  THEN 
ALPN(K, J)— 1.D+0 
ALPO (K,J)-1. D+0 
END  IF 

Kll— KAPPA (K, I , J)*B(K, I , J)+KAP(K, I , J)*B(K, I , J)*ALPN(K, J)+ 
C KA(K,I,J)*B(K,I,J)*ALPO(K,J) 

K22— KAPPA (K, I,J-1)*B(K,I,J-1)+ 

C KAP(K,I,J-1)*B(K,I,J-1)*ALPN(K,J-1)+ 

C KA(K,I,J-l)*B(K,I,J-l)*ALPO(K,J-l) 


oo  ooo  o oo  ooo 


ENDIF 

Z— OPTL(K, I , J) 

CALL  FEI(E1I,E2I,E3I,Z) 

STSUM-3 . 14159*(Kll*E2I+K22*EOLD)*DABS(Y(K,  J-l)  -Y(K,  J)  ) 
IF(IQ9.EQ.O)  THEN 
WRITE(8 , 2221)  J,I,STSUM 

2221  FORMAT ( IX , ' AT  J -',12,'  BAND  ',12,'  QR-',D11.4) 

ENDIF 

145  SUM-SUM+STSUM 
E0LD-E2I 
150  CONTINUE 

WRITE(*,103)  I, SUM 
WRITE(8 , 103)  I, SUM 

103  F0RMAT(/, ' FOR  BAND  ',12,'  QR  - '.D11.4,'  WATTS/SQ.CM.') 

. WQR— WQR+SUM 
180  CONTINUE 

WRITE(* , 101)  WQR 
WRITE (8, 101)  WQR 

101  FORMAT (/'  TOTAL  QR  -' .D11.4,'  WATTS/SQ.CM.') 

200  CONTINUE 
RETURN 
END 


SUBROUTINE  FEI(E1I,E2I,E3I,Z) 

IMPLICIT  REAL*8 (A-H, 0-Z) 

COMMON  /RADI/  RRHO(30 , 30) , Y(30 , 30) ,YBDY(30) 
COMMON  /RAD3/  B(30,8,30) 

COMMON  /RAD5/  OPTL(30 , 8 , 30) 

REAL  OPTL,XPST,Y,YBDY, TEMPO, TEMP, Z 
REAL  ALPN , ALP0 , B , BETN , BET0 
CALL  EXPI (Z, Ell , AUX) 

E2I— DEXP( -Z) -Z*E1I 
E3I-(DEXP(-Z)-Z*E2I)/2.0 
E2I-DEXP ( - Z*DSQRT ( 3 . D+00 ) ) 

RETURN 

END 


SUBROUTINE  EXPI (X, RES , AUX) 

IMPLICIT  REAL*8 (A-H, O-Z) 

COMMON  /RADI/  RRHO(30 , 30) , Y(30 , 30) , YBDY(30) 

COMMON  /RAD 3/  B<30,8,30) 

COMMON  /RAD 5/  OPTL(30 , 8 , 30) 

REAL  OPTL  ,XPST,Y,YBDY, TEMPO, TEMP, Z 
REAL  ALPN, ALPO.B, BETN ,BETO 
IF(X-1. ) 2,1,1 

1 YY-1 . /X 

AUX-1 . -YY*( ( (YY+3 . 377358)*YY+2 . 052156)*YY+2 . 709479D-01)/( ( ( (YY* 

Cl. 072553+5. 716943)*YY+6 . 945239)*YY+2 . 593888)*YY+2 . 709496D-01) 

RES— AUX*YY*DEXP  ( - X) 

RETURN 

2 IF(X+3 . ) 6,6,3 

3 AUX-( ( ( ( ( ( (7 . 122452D- 7*X- 1 . 766345D- 6)*X+2 . 92843 3D- 5 )*X- 2 .335379D-4 
C)*X+1 . 664156D- 3)*X-1 . 041576D-2)*X+5 ,555682D-2)*X-2. 500001D- 1)*X 
C+9 . 999999D- 1 

RES— l.D+30 
IF (X)  4,5,4 


4 RES-X*AUX-DLOG(ABS(X) ) -5 . 772157D-1 

5 RETURN 

6 IF(X+9 . ) 8,8,7 

7 AUX-1 . - ( ( ( (5 . 176245D-2*X+3 . 061037)*X+3 . 243655D+l)*X+2 . 244234D+2)*X 
C+2 . 486697D+2)/( ( ( (X+3 . 995161)*X+3 . 893944D+l)*X+2 . 263818D+1)*X 

C+l . 807837D+2) 

GO  TO  9 

8 YY-9 ./X 

AUX-1 . -YY*( ( (YY+7 . 659824D- l)*YY-7 . 271015D-1)*YY-1 . 080693 )/( ( ( (YY 
C*2. 518750+1. 122927D+l)*YY+5.921405)*YY-8.666702)*YY-9. 724216) 

9 RES-AUX*DEXP(-X)/X 
RETURN 

END 


<o0£ 


LISTING  OF  INPUT  FILE  RR3W.NUM 


Gob 


10.22.83146900. . 1.4 

20. . 5.65. .3. .01 

3392.14.28.016.1.0.  .768.4.1.114981. .0,-. 42163 

2275. . 32. .1.0.. 232. 6. 1.60500.. 0.1. 21618 

1. 14. 008.0.  4. 707E+12, 0,4, 1,0, 0,1. 67997 

1.16. . 0.2.4681E+12,0,5,1,0,0,2.1032 

2739. . 30. 008. 1.9. 0073E+11, 0,8, 1,76883. ,0,1.23256 

3421. . 30. 008. 1.1. 0826E+13, 0,3, 1,127698. ,0, .3786099 
1, 5. 4862E-04, 0,0, 0,1, 1,0, 0,-14. 23517 

3129. . 28. 016. 1.1. 505E+13, 0,4, 1,101242. 3, 0,1. 00426 

1. 14. 008. 0. 1.8759E+13, 0,6, 1,0,0, .29368 

1.16. . 0.1.5625E+13, 0,5, 1,0, 0,1. 8794 
2, 1.19E+21, -1.5,59380. ,1. 

5.5.18E+21, -1.5,75490. ,1. 

3,5. 0E+19 , - 1 . 5 , 0 , 2 . 

2,1. 0E+12 ,0.5, 3120 . ,1. 

1, 5. 0E+13, 0,38016. ,1. 

6,1. 8E+21 , -1. 5 , 0 , 1. 

3, 1.4E+13, 0,67800,1. 


3, 2. 34E+11, 0.5, 120000,1. 

9, 2. 34E+11, 0.5, 120000,1. 

3, 4. 16E+13, 0.5, 120000,1. 

4, 5. 49E+13, 0.5, 104500,1. 

4.2. 

3.2. 

1,1. 

5.2. 

5.2. 

8.2. 

9,2. 

9,2. 

9,2. 

9.2. 

10.2. 

64,1 

64,1 

64,1 

64,1 

64,1 

64,1 

64,1 

64,1 

64,1 

64,1 

64,1 

64,1 

64,1 

64,1 

64,1 

64,1 

64,1 

64,1 

64,1 

64,1 

64,1 

1,1, 1,1, 1,1, 0,0, 0,0, 0,0, 0,0, 0,0, 0,0, 0,0, 0,0 

1,1, 1,1, 1,1, 0,0, 0,0, 0,0, 0,0, 0,0, 0,0, 0,0, 0,0 

1,1, 1,1, 1,1, 0,0, 0,0, 0,0, 0,0, 0,0, 0,0, 0,0, 0,0 

1,1, 1,1, 1,1, 0,0, 0,0, 0,0, 0,0, 0,0, 0,0, 0,0, 0,0 

1,1, 1,1, 1,1, 0,0, 0,0, 0,0, 0,0, 0,0, 0,0, 0,0, 0,0 
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1.1.1 

1, 

1 

.1 

.0, 

0, 

0,0,0 

0,0,0 

o 

0 

.0 

.0 

0. 

0.0,0 

1.1.1 

1 

1 

.1 

,0 

0. 

0.0,0 

1.1.1 

1 

1 

,1 

,0 

0, 

0,0,0 

1.1.1 

1 

1 

.1 

.0 

0, 

0,0,0 

0,1,0 

0 

0 

,0 

,0, 

0, 

0,0,1 

0,0,0 

2 

0 

,0 

,0 

0, 

0,0,1 

0,0,0 

o 

1 

,0 

,0 

0, 

0,0,1 

0,0,1 

1 

0 

,0 

,0 

0, 

0,0,1 

1.0,0 

0 

0 

,0 

,0, 

0, 

0,0,1 

0,0,2 

0, 

0 

.0 

.0 

0, 

0,0,1 

0,1,1 

0 

0 

.0 

.0 

0. 

0.0,0 

0,0,0 

1, 

1 

.0 

,0 

0. 

0.0,0 

1,0,0 

1, 

0 

.0 

.0 

0, 

0,0.0 

0,0,1 

0, 

1 

.0 

,0 

0, 

0.0.0 

0,0,0 

0, 

0 

,1 

.1 

0, 

0.0,0 

0,0,1 

1, 

0 

.0 

,0 

0. 

0,0,0 

0.0,2 

0, 

0 

.0 

.0, 

0. 

0,0,0 

0,0,0 

0, 

0 

.0 

,1, 

1, 

0,0,0 

0,0,2 

0, 

0 

,0 

,0, 

0, 

0,0,0 

0,0,1 

0, 

0 

,0 

,1, 

0, 

1,0,0 

0,0,1 

0, 

0 

,0 

,0, 

0, 

1,0,0 

0,0,0 

0, 

0 

,0 

,1, 

0, 

2.0,0 

0,0,1 

0, 

0 

,0 

,1, 

0, 

0,0,0 

0,0,0 

0, 

0 

,0 

,2, 

0, 

1,0,0 

0,0,0 

1, 

0 

,0 

.1, 

0, 

0,0,0 

0,0,0 

0, 

0 

,0 

,2, 

0, 

0,1,0 

0,0,0 

2, 

0 

,0 

.0, 

0, 

0,0 

0.1,0 

0, 

0 

,0 

,0, 

0, 

0,0 

0,0,1 

1. 

0 

,0 

,0, 

0, 

0,0 

0,0,0 

0, 

1 

,0 

,0, 

0, 

0,0 

0,0,2 

0, 

0 

.0 

,0, 

0, 

0,0 

1,0,0 

0, 

0 

,0 

,0, 

0, 

0,0 

0,0,0 

1, 

1 

,0 

,0, 

0, 

0,0 

0,1,1 

0, 

0 

,0 

,0, 

0, 

0,0 

0,0,1 

0, 

1 

,0 

,0, 

0, 

0,0 

1,0,0 

1, 

0, 

,0 

,0, 

0, 

0,0 

0,0,1 

1, 

0 

,0 

,0, 

0, 

0,0 

0,0,0 

0, 

0 

,1 

,1, 

0, 

0,0 

0,0,0 

0, 

0 

,0 

,1, 

1, 

0,0 

0,0,2 

0, 

0, 

,0, 

,0, 

0, 

0,0 

0,0,1 

0, 

0, 

,0, 

,1. 

0, 

l.o 

0,0,2 

0, 

0, 

,0, 

,0, 

0, 

0,0 

0,0,0 

0, 

0, 

,0, 

,1, 

0, 

2,0 

0,0,1 

0, 

0, 

.0, 

.0, 

0, 

1,0 

0,0,0 

0, 

0, 

0, 

,2. 

0, 

1,0 

0,0,1 

0, 

0, 

.0, 

,1. 

0, 

0,0 

0,0,0 

0, 

0, 

.0, 

2 , 

0, 

0,1 

0,0,0 

1, 

0, 

0, 

1. 

0, 

0,0 

5.675E 

-04, 

5. 

675E 

-04,5, 

5.675E 

-04, 

5. 

675E 

-04 

1.443E 

-07, 

1. 

443E 

-07,1. 

1.443E 

-07, 

1. 

443E 

-07 

0,0,0, 

o, 

0, 

0, 

o, 

0, 

0,0 

0,0,0, 

o, 

0, 

0,0, 

0, 

0,0 

1.513E 

-04, 

1. 

513E 

-04,1. 

1.513E 

-04, 

1. 

513E 

-04 

1.513E 

-04, 

1. 

513E 

-04,1. 

1.513E 

-04, 

1. 

513E 

-04 

0,0,0, 

o, 

0, 

0, 

0, 

0, 

0,0 

I, 0,0,0, 0,0,0, 0,0, 0,0,0 

1. 0. 0. 0.0. 0.0. 0.0. 0.0.0 

1. 0. 0. 0.0. 0.0. 0.0. 0.0.0 

1. 0. 0. 0.0. 0.0. 0.0. 0.0.0 
(.0,0, 0,0, 0,0, 0,0, 0,0,0 


675E-04,5.675E-04,5.675E-04,5.675E-04,5.675E-04,5.675E-04, 
443E-07 , 1 .443E-07 , 1.443E-07 ,1.443E-07,1.443E-07,1.443E-07, 

513E-04,1.513E-04,1.513E-04,1.513E-04,1.513E-04,1.513E-04, 
513E-04 , 1 . 513E-04 , 1 . 513E-04 , 1 . 513E-04 , 1 . 513E-04 , 1 . 513E-04 , 


c-  7 


&o8 


5 . 675E-04 , 5 . 675E-04 , 5 . 675E-04 , 5 . 675E-04 , 5 . 675E-04, 5 . 675E-04 , 5 . 675E-04 , 5 . 675E-04 , 
5 . 675E-04 , 5 . 675E-04 
0,0, 0,0, 0,0,0, 0,0,0 
0,0, 0,0, 0,0, 0,0, 0,0 

-.09952, -.09952, -.09952, -.09952, -.09952, -.09952, -.09952, -.09952, -.09952, -.09952 
.37177, .37177, . 37177 , . 37177 , . 37177 , . 37177 , . 37177 , . 37177 , . 37177 ,. 37177 
0,0, 0,0, 0,0, 0,0, 0,0 
0,0, 0,0, 0,0, 0,0, 0,0 

-.2226, -.2226, -.2226, -.2226, -.2226, -.2226, -.2226, -.2226, -.2226, -.2226 
-.2226, -.2226, -.2226, -.2226, -.2226, -.2226, -.2226, -.2226, -.2226, -.2226 
0,0, 0,0, 0,0, 0,0, 0,0 

-.09952, -.09952, -.09952, -.09952, -.09952, -.09952, -.09952, -.09952, -.09952, -.09952 
0,0, 0,0, 0,0, 0,0, 0.0 
0,0, 0,0, 0,0, 0,0, 0,0 

163.63,163.63,163.63,163.63,163.63,163.63,163.63,163.63,163.63,163.63 
179.32,179.32,179.32,179.32,179.32,179.32,179.32,179.32,179.32,179.32 
0,0, 0,0, 0,0, 0,0, 0,0 
0,0, 0,0, 0,0, 0,0, 0,0 

135.3,135.3,135.3,135.3,135.3,135.3,135.3,135.3,135.3,135.3 

135.3.135.3.135.3.135.3.135.3.135.3.135.3.135.3.135.3.135.3 
0.0, 0,0, 0,0,0, 0,0,0 

163.63,163.63,163.63,163.63,163.63,163.63,163.63,163.63,163.63,163.63 
0,0, 0,0, 0,0, 0,0, 0,0 
0,0, 0,0, 0,0, 0,0, 0,0 

1.3. 6. 2 

3. 2. 1.3. 1.3 
4, 6, 4, 6 

5, 3, 1,5,1 
2,2, 2, 4, 2, 4, 2, 4 

1.6.3 
1 

2. 4. 2. 2 
1,3, 5, 5, 1,5 

4. 6. 4. 4. 2 

0,71592,85343,99212 
0 , 11342 , 18879 , 51385 , 52104 , 71026 
0,27659,27670,41496 
0,228,326,22831,48622 

0,174,63597,65381,76676,75361,87568,86359 

0,57528,84205 

0 

0,13191,36634,92977.4 

0,70.5,188.5, 22036 . 5 , 47029 . 68 , 67864 . 8 

0,38571,38601,58223.5,58225 

46, 18800, 3393. 9685, 20. 797195, 1 . 0801997E-02  , -7. 32343E-04 
33,9896,2273.1279,17.365295,7. 8529954E-02 .-2.057468E-03 
0,0, 0,0, 0,0 
0,0, 0,0, 0,0 
0,0, 0,0, 0,0 
0,0, 0,0, 0,0 
0,0, 0,0, 0,0 
0,0, 0,0, 0,0 
0,0, 0,0, 0,0 
0,0, 0,0, 0,0 
N2 
02 
N 
0 

NO 

N0+ 


feel 


E- 

N2+ 

N+ 

0+ 

02_+_M. .>20_+_M 
20_+_M . . >02_+_H 
N°_+~M. . >N_+_0_+_M 
N_+_0_+_M. . >N0_+_M 
N2_+_M. .>2N_+_M 
2N_+_M . . >N2_+_M 
N_+_02 . .>N0_+_0 
N0_+_0 . . >N_+_02 
N2_+_0. .>N0_+_N 
N0_+_N . .>N2_+_0 
N0+_+_E- . . >N_+_0 
N_+_0 . . >N0+_+_E - 
N_+_N . .>N2+_+_E- 
N2+_+_E* . . >N_+_N 
N_+_N . . >N+_+_E -_+_N 
N+_+_E - _+_N . . >N_+_N 
N_+_N+ . . >N+_+_E - _+_N+ 
N+_+_E-_+_N+. . >N_+_N+ 
N_+_E - . ,>N+_+_2E- 
N+_+_2E* . . >N_+_E - 
0_+_E - . >0+_+_E - _+_E - 
0+  + E-  + E- .>0  + E- 


STATEMENT  LISTING  OF  PROGRAM  AFENEW 


c — — - 

c 

C PROGRAM  AFETEW  ( IBM-3090,  "WYLBUR"  VERSION  ) 

C 

C AN  INVERSE  HYPERSONIC  FLOW  SOLUTION  FOR  AN  AFE/AOTV  BODY  IN 

) C CHEMICAL  NONEQUI LIBRIUM  USING  COUPLED  VIBRATION-DISSOCIATION  MODELS, 

C SHOCK  JUMP  APPROXIMATIONS,  ELECTRON  TEMPERATURE  MODELING,  AND 

C UNCOUPLED  RADIANT  HEAT  TRANSFER  USING  A METHOD  DERIVED  BY  S.MASLEN 

C 

C BASED  ON  AN  ORIGINAL  PROGRAM  BY  B.L.  WEIGEL  FOR  WILLIAM  L.  GROSE 

C VIRGINIA  POLYTECHNIC  INSTITUTE 

C 

C MAJOR  PROGRAM  REVISIONS  BY  G.BOBSKILL,  R . GREENDYKE , AND  L. CARLSON 

C TEXAS  A&M  UNIVERSITY 

C 

C - 

C 

C CALITH  : INTEGRATION  ROUTINE  BY  CHARLES  E.  TREANOR 

C THE  NUMERICAL  INTEGRATION  ALGORITHM  USED  IS  FOUND  IN  A METHOD 

C FOR  THE  NUMERICAL  INTEGRATION  OF  COUPLED  FIRST  ORDER 

C DIFFERENTIAL  EQUATIONS  WITH  GREATLY  DIFFERENT  TIME  CONSTANTS 

C 

C FOFE  - EVALUATE  E BY  NEWTON  ITERATION  METHOD 

C FOFTS1  - EVALUATE  TS  BY  NEWTON  ITERATION  METHOD.  CHEMISTRY  FROZEN 

C F0FT23  - FOFTS1  WITH  N2  FROZEN,  02  DISSOCIATING  OR  BOTH  N2  & 02  DISS. 

C FTLUP  - INTERPOLATION  ROUTINE 

C 

C DATA  FILES 

C 

C UNIT  5 IS  USED  TO  READ  DATA  FROM  FILE  SCREEN 

C UNIT  7 IS  USED  TO  READ  DATA  FROM  INPUT  DATA  FILE 

C UNIT  B IS  USED  FOR  THE  OUTPUT  DATA  FILE 

C UNIT  9 IS  USED  TD  STORE  VIBRATIONAL  ENERGY  DATA  AT  THE  SHOCK  (FORMATTED) 

C UNIT  10  IS  USED  TO  STORE  ALL  STAGNATION  QUANTITIES 

C UNIT  11  IS  USED  TO  STORE  ALL  EVIS  DATA  FOR  COMPUTATIONAL  PURPOSES 

C UNIT  12  IS  USED  TO  STORE  ALL  PRESSURE  DATA 

C UNIT  13  IS  USED  TO  STORE  ALL  DPDX  DATA 

C UNIT  14  IS  USED  TO  STORE  QUANTITIES  FOR  PHYSICAL  SPACE  CALCULATIONS 

C UNIT  15  IS  USED  TO  STORE  ALL  WARNINGS  DURING  PROGRAM  EXECUTION 

) C 

' C INPUT-NAMELIST 

C 

C DELX  « INCREMENT  ALONG  SHOCK  , cm 

C ZSTERM  * LENGTH  OF  SYMMETRY  AXIS  , Z , cm 

C IMAX  = MAX.  NO.  OF  I-S  SPECIES  , LESS  THAN  OR  EQUAL  TO  25 

C JMAX  « MAX.  NO.  OF  J-S  REACTIONS  , LESS  THAN  OR  EQUAL  TO  50 

C MJ  CODE  INDICATING  WHICH  SPECIES  , I , TO  USE  TO  CALCULATE 

C COUPLING  FACTOR,  PHI  SUB  J , FOR  REACTION  J 

C M * 1 FOR  VIBRATIONAL  NON-EQUILIBRIUM 

C ■ O FOR  VIBRATIONAL  EQUILIBRIUM 

C R = UNIVERSAL  GAS  CONSTANT  , erg/(mole-K) 

C GAMMA  « RATIO  OF  SPECIFIC  HEATS 

C Cl INF  » FREE  STREAM  MASS  FRACTION  FOR  EACH  SPECIES 

C PINF  « FREE  STREAM  PRESSURE  , dynes/cm**2 

C TINF  = FREE  STREAM  TEMPERATURE  . K 

C VINF  = FREE  STREAM  VELOCITY  , cm/sec 

C MU I « MOLECULAR  WT . FOR  EACH  SPECIES  , gm/mole 

C THETAI  «=  CHARACTERISE  VIBRATIONAL  TEMPERATURE  , K 

C DGENI  = FUDGE  FACTOR  TO  PERMIT  APPROXIMATING  POLYATOMIC  MOLECULE 

C BY  A DIATOMIC  MOLECULE 

C FI  =0  FOR  MONATOMIC  SPECIES 

C = 1 FOR  ALL  OTHERS 

C DELHI  = HEAT  OF  FORMATION  , ergs/mole 

C DELI  = DISSOCIATION  ENERGY  OF  SPECIES  , K 

C EVI  = VIBRATIONAL  ENERGY  OF  SPECIES  , ergs/g 

C BI  3/2*1r>(2*PI*M1*k/h**2)  + ln(k)  + FI ( I )*1 n(THETAI (Rotational ) ) 

C + 1 n(GIL(I , 1 ) ) FOR  EACH  SPECIE  I 

C LI  NUMBER  OF  ELECTRONIC  LEVELS  FOR  EACH  SPECIES  ( LI.LE.20  ) 

C GIL  = DEGENERACY  OF  L-TH  ELECTRONIC  LEVEL  FOR  I-TH  SPECIES 

C EPSIIL  = L-TH  ELECTRONIC  ENERGY  LEVEL  FOR  I-TH  SPECIES  , K 

C AJ  FREQUENCY  FACTOR  IN  ARRENIUS  TYPE  RATE  EON. 

C BJ  TEMPERATURE  EXPONENT  IN  ARRENIUS  TYPE  EQN . 

C EJ  ACTIVATION  ENERGY  IN  ARRENIUS  TYPE  EQN. 

C DIRECT  = DIRECTION  OF  THE  REACTION  ( FORW.  = 1.0  , BACK.  = 2.0  ) 

C AIJ  = FACTOR  TO  ALLOW  USE  OF  GENERAL  SPECIES  IN  REACTION  EQNS . 

C i.e.  (N2  + M = 2N  + M),  AIJ  = 1.0  OR  (N2  + 02  = 2N0),  AIJ  = 0.0 

C NUIJ  = STOICHIOMETRIC  COEFFICIENTS  OF  I-TH  REACTANT  IN  J-TH  REACTION 

C NUPIJ  = STOICHIOMETRIC  COEFFICIENT  FOR  I-TH  PRODUCT  IN  J-TH  REACTION 

C ALPIK  = FACTORS  IN  EQN.  FOR  VIBRATIONAL  RELAXATION  TIME 

C BETAIK  = FACTORS  IN  EQN.  FOR  VIBRATIONAL  RELAXATION  TIME 


c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 


c 


c 


c 

c 

c 

c 

c 


SIGIK 

NIP 

UP 

WE 

WEXE 

WEYE 

WEZE 

XI 

ELE  1 
ELE2 
XPST 


NXPST 

Cl  MAX 
HCHCKT 

TCHCKT 

PHMAX 

IPF 


* FACTORS  IN  EON.  FOR  VIBRATIONAL  RELAXATION  TIME 

* NUMBER  OF  VIBRATIONAL  LEVELS  FOR  ANHARMONIC  OSCILLATOR  , K 

* CHARACTERISTIC  PROBABILITY  TEMPERATURE  . K 

* CONST.  USED  TO  COMPUTE  ANHARMONIC  OSCILLATOR  , K 

* CONST.  USED  TO  COMPUTE  ANHARMONIC  OSCILLATOR  . K 

« CONST.  USED  TO  COMPUTE  ANHARMONIC  OSCILLATOR  , K 

* CONST.  USED  TO  COMPUTE  ANHARMONIC  OSCILLATOR  , K 

* INITIAL  COMPUTING  INTERVAL  , .0001220703125  UNLESS  INPUT  , cm 

* (2* IMAX  + 1)  VALUES  USED  BY  INTEGRATION  SCHEME 
NORMALLY  0. 1,0.5.  OR  .05 

« ( 2* IMAX  + 1)  VALUES  USED  BY  INTEGRATION  SCHEME 
NORMALLY  . 05,-1.  OR  .01  AND  . LT . ELE 1 

« 99  OR  LESS  Xs  AT  WHICH  PHYSICAL  SPACE  CALCULATIONS  ARE 
DESIRED.  THEY  MUST  BE  MULTIPLES  OF  DELX  IN  ORDER  TO  HAVE 
RS  COST , ZS , AND  SINT  VALUES  AND  LAST  MUST  BE  . GT . X AT 
ZSTERM.  THEREFORE.  XPST(NXPST)  SET  - X AT  ZSTERM  + 100.0 
IN  PROGRAM.  XPST ( 1 ) MAY  NOT  BE  0.0  . THEREFORE,  SET 
XPST(-)  * DELX  IN  PROGRAM 

« NUMBER  OF  X-S  AT  WHICH  PHYSICAL  SPACE  CALCULATIONS  ARE 
DESIRED 

* MAX.  CJ  OR  COMPUTING  INTERVAL  0.0625  UNLESS  INPUT  OTHERWISE 

* CONTROL  ON  SIZE  OF  COMPUTING  INTERVAL  IN  CHECK 
I F ( ABS ( HPREV  - H)/H . GT . HCHECK)  REDUCE  INTERVAL 

« CONTROL  ON  SIZE  OF  COMPUTING  INTERVAL  IN  CHECK 
I F ( ABS(TPREV  - T )/T . GT . TCHECK ) REDUCE  INTERVAL 

* CONTROL  ON  COMPUTING  INTERVAL  .LE.  65.0 

* OUTPUT  PRINT  FREQUENCY 


STOPS 


STOP  1 
STOP  2 
STOP  13 
STOP  30 
STOP  66 
STOP  301 
STOP  321 
STOP  663 
STOP  665 
STOP  670 


INCORRECT  INPUT 

IN  MAIN  WHEN  NXPST  IS  .LE.  2 

IN  SHOCKG 

IN  CHECK  WHEN  COMPUTING  INTERVAL  . LT . I.OE-15 

IN  BASIC  WHEN  NO  CONVERGENCE  ON  E ITERATION  ( FOFE ) 
IN  MAIN  FOR  ERROR  IN  XPST  ARRAY  OR  IZTERM  . GT . 500 
IN  MAIN  WHEN  NO  CONVERGENCE  ON  TS  ITERATION  (FOFTS) 
IN  MAIN  WHEN  X .NE.  VARI(IPSI) 

IN  MAIN  AFTER  AN  INTEGRATION  ATTEMPT 
IN  MAIN  WHEN  A Cl  NEGATIVE 


.IMPLICIT  REAL*8  ( A-H , 0-Z  ) 

COMMON  /A  1 / TE1.TE2.M, IX, IMAX.IPSI, MODEL 
COMMON  / A2/  P ( 500) , DPDX ( 500) , VARI ( 500) 

FOLLOWING  7 VARIABLES  DIMENSIONED  BY  IMAX 

COMMON  /A3/  EVIINF(25) , THETA I ( 25 ) , MU I (25) , FI (25) .DELHI (25) , 

* CIINF(25) ,LI(25) 

COMMON  /A4/  R.MUINF .DELTA, LAMSQ , OMEGSQ , OMEGA, MU. T.U.TINF 

FOLLOWING  2 VARIABLES  DIMENSIONED  BY  ( LMAX  IN  LI, IMAX) 
COMMON  / A5/  EPSI I L ( 20 , 25 ) , GI L ( 20 , 25 ) , CID ( 200 , 50) 

COMMON  / A6/  VAR ( 52 ) , CUVAR (52) . DER ( 5 1 ) 

FOLLOWING  4 VARIABLES  DIMENSIONED  BY  JMAX 

COMMON  / A7/  MJ( 50) , EJ( 50) , A J ( 50) , BJ( 50) .DIRECT (50) 

FOLLOWING  3 VARIABLES  DIMENSIONED  BY  IMAX 
COMMON  / A8/  TVI (25) ,DGENI (25) ,BI(25) ,NI(25) 

FV'T^f  IMAX'I 


COMMON 

COMMON 

COMMON 

COMMON 

COMMON 

COMMON 

COMMON 

COMMON 

COMMON 

COMMON 

COMMON 

COMMON 

COMMON 

COMMON 

COMMON 

COMMON 


/A9/  EVIS(25) ,XPST( 100) 

FOLLOWING  3 VARIABLES  DIMENSIONED  BY  ( IMAX+ 1 . JMAX ) OR  (IMAX, JMAX) 
/A  10/  NUIJ(26,50),AIJ(25,50) . NUPI J( 25 , 50) 

FOLLOWING  3 VARIABLES  DIMENSIONED  BY  (IMAX, JMAX) 
/All/  SIGIK(25,25) , ALPIK(25,25) , BETAIK( 25 . 25 ) 

/A  12/  SINTM( 1500) ,COSTM( 1500) , RSM( 1 500) ,RCM( 1500) ,X1 ( 1500) 

, ZSM( 1500) 

/A  13/  SP.TS, DELX. ZSTERM, IZTERM, NSR , MW 

/A  14/  EINF , PINF , RHOINF , VINF , E . JMAX . KEYINT , RHO , HSTAG 

/A  15/  PFTL.KITR1 ,NIP(25) ,UP(25) 

/A  16/  WE (25) ,WEXE(25) ,WEYE(25) ,WEZE(25) , IUNEG 
/A  1 7/  ELB , SPEC , CJ , TPREV , HPREV , HCHECK , TCHECK 
/A18/  ITNEG , I EXP 
/A  19/  ELE1(51),ELE2(51),NERR 

/RAD/  RCON( 100, 10,40) ,RRHO( 100,40) ,TEMP( 100,40) 

, TSTAG , Y ( 100,40) ,NXCON,NPTS( 100) 

/RADC/  YBDY( 100) ,B( 100 , 8 , 40) , OPTL( 100,8,40) 

/RADO/  TEMPO ( 100,40) , ALPN( 100, 40) , ALPO ( 100,40) 

/RADOL/  BETN( 100,40) ,BETO( 100,40) 

/PLOT/  XSTR1 (2000) , ZSTR1 ( 2000) . RSTR 1 ( 2000) 

DELI ( IMAX) 


DIMENSION  DELI(25) ,PREC(25) 
DIMENSION  RUT ( 200) , PSI STG( 200) 
DIMENSION  CIG(25, 1 1 ).EIG(25, 11) 


c 


J 


c 


15 

C 


21 

C 


c 


DIMENSION  PSIG(11).TG(11).HG(11).CIT(11),EIT(11).EG(11) 

CM(IMAX),CI(IMAX),EVI(IMAX) 

DIMENSION  CM (25) ,CI(25),EVI(25) 

EQUIVALENCE  ( VAR( 1 ) . XVAR) . ( VAR( 2 ) . H) , ( VAR( 3 ) . Cl ( 1 ) ) 

REAL*8  MU I . MUINF , MU . MINF , MINF SQ . LAMBDA , LAMSQ 
CHARACTER*30  INFILE .OUTFL1 .OUTFL2 
CHARACTER*30  SPECIE (25 ). REACT( 50) 

CHARACTER*80  INDATA 

READ  INPUT  FROM  FILE  SCREEN 


READ(5, 15)  INDATA 
READ(5, 15)  INDATA 
READ(5, 15)  INDATA 
READ(5,15)  INDATA 
READ( 5 , 15 ) INDATA 
READ(5, 15)  INDATA 
READ(5, 15)  INDATA 
READ(5, 15)  INDATA 
READ(5, 15)  INDATA 
READ( 5 , 15 ) INDATA 
READ(5, 15)  INDATA 
READ(5, 15)  INDATA 
READ(5, 15)  INDATA 
READ( 5 ,15)  INDATA 
READ( 5 ,15)  INDATA 
READ(5, 15)  INDATA 
READ(5, 15)  INDATA 
READ(5, 15)  INDATA 
READ(5 , 15)  INDATA 
READ(5 , 15)  INDATA 
READ(5, 15)  INDATA 
READ(5, 15)  INDATA 
READ( 5 , 15 ) INDATA 
READ( 5,15)  INDATA 
READ(5, 15)  INDATA 
READ(5 , 15 ) INDATA 
READ(5 , 15)  INDATA 
READ(5, 15)  INDATA 
READ(5, 15)  INDATA 
READ(5, 15)  INDATA 
READ(5,15)  INDATA 
READ(5, 15)  INDATA 
READ(5, 15)  INDATA 
READ(5, 15)  INDATA 
READ(5 , 15)  INDATA 
READ(5 ,15)  INDATA 
READ(5, 15)  INDATA 
READ(5, 15)  INDATA 
READ( 5 , 15 ) INDATA 

READ( 5 , * ) IPF.M.NSR. I ANS . MW , MODEL . IQ3.IQ1 , IQ2 , IQ4 , 105 , IQ7  , IQ6 
.108. 109. 1010 

READ(5, *)  IS1.IS2,IS3.IS4,IS5,Ise 
RE AD ( 5 , * ) XI , DELX . 2STERM , VINF , PINF , TINF 
READ ( 5 , * ) IS7 
FORMAT (A80) 


NSR 1 ■=  NSR  + 1 

NSRM1  = NSR  - 1 

NERR  = O 

ITNEG  = O 

IEXP  = 0 

NEG  = 0 

IUNEG  = O 

DO  21  I - 1,52 

VAR(I)  = 0.0 

CUVAR(I)  ■=  0.0 

IF  (I .EQ.52)  GO  TO  21 

DER(I)  = 0.0 

ELEI(I)  - 0.0 

ELE2( I ) = 0.0 

CONTINUE 

READ  INPUT 

READ (7,*)  IMAX.JMAX.R. GAMMA 

READ( 7 , * ) NXPST , CIMAX , PHMAX , TCHCKT , HCHCKT 

IF  (NXPST. EO. 20)  NXCON  = NXPST  - 1 
IF  (NXPST. EQ. 40)  NXCON  = NXPST  - 2 

DO  42  I = 1 , I MAX 

READ( 7 , * ) THETA I ( I ) , MU I (I),FI(I),DELHI(I),CIINF(I),LI(I), DGENI ( I ) 
* ,DELI(I),EVI(I).BI(I) 


42 


DO  45  d - 1 , UMAX , 2 

45  READ(7.»)  MU(U),AJ(U),BU(J),EJ(J),DIRECT(U) 

DO  48  J ■ 2, UMAX. 2 
48  READ( 7 , * ) MU(U) ,DIRECT( J) 

IMAX21  ■ 2* I MAX  + 1 
DO  51  I » 1.IMAX21 
51  READ(7,*)  ELE 1(1), ELE2( I ) 

DO  54  I « 1 , I MAX 

54  READ(7  , * ) (AIJ(I.U).J  » 1.JMAX) 

DO  57  J « 1 , UMAX 

57  READ( 7 , * ) (NUIU(I.U).I  ■ 1.IMAX+1) 

DO  60  U « 1 , UMAX 

60  READ( 7 , * ) (NUPIU(I.U).I  - 1.IMAX) 

DO  63  I - 1 , I MAX 

63  READ( 7 . * ) (ALPIK(U, I ) ,U  « 1.IMAX) 

DO  66  I - 1 , 1 MAX 

66  READ(  7,*)  (BETAIK(U , I ) , U «=  1.IMAX) 

DO  69  I ' 1 , I MAX 

69  READ( 7 , * ) ( SIGIK( U , I ) . U * 1.IMAX) 

DO  72  I « 1 . I MAX 
LI  I = LI ( I ) 

72  READ(7  , * ) (GIL(L.I).L  ■=  1.LII) 

DO  75  I - 1 , I MAX 
LI  I - LI ( I ) 

75  READ ( 7 , * ) ( EPSI I L( L . I ) . L = 1.LII) 

IF  (IANS.EO. 1)  THEN 

NXPST  - 4 

XPST(1)  - ( IS3  - NSR ) *DELX 
XPST ( 2 ) - ( IS4  - NSR )*DELX 
XPST ( 3 ) = ( IS5  - NSR)*DELX 
XPST ( 4 ) = (IS6  - NSR )*DELX 
GO  TO  78 
ENDIF 

DO  76  I - 1,  NXPST 

NPTS(I)  = I 

76  XPST ( I ) = DELX*I 
78  DO  80  I * 1 , I MAX 

80  READ( 7 , * ) NIP( I ) , UP( I ) , WE ( I ) . WEXE ( I ) , WEYE( I).WEZE(I) 

IMAXP2  = IMAX  + 2 

C SUM  OF  Cl INF  SHOULD  BE  1.0 

SUM  » 0.0 
DO  81  I « 1 , IMAX 

81  SUM  - SUM  + CIINF(I) 

IF  (SUM. EO. 1.0)  GO  TO  85 
WRITE( 15,82)  SUM 

82  FORMAT( IX. 'SUM  OF  CIINF(I)  SHOULD  BE  1:  IT  IS  = '.Eli. 4.'  STOP  1') 
STOP 

C STOP  1 

85  HCHECK  - HCHCKT 
TCHECK  « TCHCKT 

C READ  IN  AND  WRITE  OUT  SPECIES  AND  REACTIONS 

DO  88  I = 1 , IMAX 
88  READ ( 7 , 90)  SPECIE(I) 

90  FORMAT ( A30) 

WRITE (8,95) 

95  FORMAT ( // ) 

WRITE ( 8 , 100) 

100  FORMAT( 14X. 'SPECIES'/) 

DO  110  I = 1 , IMAX 
105  FORMAT (1X.I5.11X, A30) 

110  WRITE ( 8 , 105 ) I , SPECIE ( I ) 

WRITE ( 8 , 95 ) 

DO  112  I = 1 , UMAX 
112  READ ( 7 , 90)  REACT ( I ) 

WRITE(8 , 115) 

115  FORMAT( 14X, 'REACTIONS'/) 

DO  120  I = 1 , UMAX 
120  WRITE (8 , 125  ) I.REACT(I) 

125  FORMAT ( IX , 1 5 , 8X , A30) 

WRITE ( 8 , 95 ) 

REWIND  7 

C STORE  PRELIMINARY  INFO.  FOR  DISSPLA 

WRITE ( 69 , * ) IMAX. UMAX, MODEL. VINF , PINF . TINF 

C PRINT  INPUT 

WR I T E ( 8 , 1 35 ) HCHCKT . TCHCKT . PHMAX 

135  FORMAT ( IX. 'HCHCKT  = ', E 1 1 . 4 , 4X . 'TCHCKT  = ' , E 1 1 . 4.4X . ' PHMAX  = ', 

* E 1 1 . 4/ ) 

WRITE ( 8 , 140)  XI .CIMAX. NXPST 

140  FORMAT(  IX. 'XI  = ' . E 1 1 . 4 , 8X , ' CIMAX  = ' , E 1 1 . 4 . 5X , ' NXPST  = '.13//) 

DO  141  I = 1 , I MAX 2 1 


141  WRITE ( 8 , 142 ) I , ELE  1 ( I ) , I . ELE2 ( I ) 

142  FORMAT ( 1X,'ELE1(/,I2,/)  « ' , E 1 1 . 4 , 5X , ' ELE2( ' . 12 , ' ) = '.Ell. 4) 
WRITE ( 8 , 95 ) 

DO  143  I • 1.NXPST 

143  WRITE ( 8 , 144 ) I.XPST(I) 

144  FORMAT( IX. 'XPST( ' , 13, ' ) * '.Ell. 4) 

WRTTF ( fl  95 ) 

WRITE (8 i 145 ) I MAX , JMAX , M 

145  FORMAT( IX, 'IMAX  « ' , 12 . 1 IX, ' JMAX  « ,,I2,13X,'M  = ',12/) 

WRITE ( 8 , 150)  DELX.ZSTERM. IPF.R, PINF.TINF.VINF, GAMMA 

150  FORMAT( IX, 'DELX  « ' , E 1 1 . 4 , 2X , ' ZSTERM  « ' , E 1 1 . 4 , 2X , 

•'PRINT  FREQ.  ■ ',I3,3X,'R  ■ ' , E 1 1 . 4 , // , IX . ' PINF  = '.Eli. 4, 

*2X , ' TINF  • '.Eli ,4,4X, 'VINF  • ' , E 1 1 . 4 , 2X , ' GAMMA  - '.E9.3//) 

WRITE ( 8 , 155) 

155  FORMAT (16X, 'MU I' ,8X, 'THETAI' ,7X, 'DGENI' , 10X, 'FI' ,9X, 'DELHI'/) 

DO  157  I • 1 , IMAX 

157  WRITE ( 8 , 160)  I . MUI ( I ) , THETAI ( I ) , DGENI ( I ) , FI ( I ) , DELHI ( I ) 

160  FORMAT ( IX, I2,8X,5(E1 1 .4,2X) ) 

WRITE ( 8 , 95 ) 

WRITE ( 8 , 161 ) 

161  FORMAT ( 16X, ' DELI ' , 8X , ' Cl INF ' , 9X , 'EVI ' , 10X , ' LI ' , 1 IX , ' BI ' / ) 

DO  163  I » 1 , IMAX 

163  WRITE ( 8 , 164  ) I , DELI ( I ) , Cl INF ( I ) , EVI ( I ) , LI ( I ) , BI ( I ) 

164  FORMAT (1X,I2,8X,3(E11 . 4 , 2X ) , 3X , 13 , 7X . E 1 1 . 4 ) 

WRITE (8,95) 

WRITE ( 8 , 165) 

165  FORMAT ( 8X , 'NIP' ,9X, 'UP' , 10X, 'WE' , 10X, 'WEXE' ,9X, 'WEYE' ,8X, 'WEZE'/) 
DO  167  I « 1 , I MAX 

166  FORMAT ( IX. I2,5X,I3,4X,E10.4,2X,E10.4,3X.E10.4,3X,E10.4,2X,E10.4) 

167  WRITE(8 , 166  ) I , NI P ( I ) , UP ( I ) , WE ( I ) , WEXE ( I ) , WEYE ( I ) . WEZE ( I ) 

WRITE (8,95) 

WRITE ( 8 , 170) 

170  FORMAT ( 1 2X , 'MJ ' , 9X , ' A J ' , 14X , ' BJ ' . 1 5X , ' E J ' , 10X , 'DIRECTION' ,/, 

» 69X , ' F=  1 , B = 2 ' / ) 

DO  180  J • 1, JMAX, 2 

175  FORMAT ( IX , 12, 2X . 18 , 3(2X , E 15 . 6 ) . 5X . F5 . 2) 

180  WRITE ( 8 , 175 ) J,MJ(J),AJ(J),BJ(J),EJ(J), DIRECT (J) 

WRITE ( 8 , 95 ) 

WRITE ( 8 , 181 ) 

181  FORMAT ( 12X, 'MJ' ,6X, 'DIRECTION' ,/,21X, 'F=1  ,B  = 2'/) 

DO  183  J = 2, JMAX, 2 

182  FORMAT (1X,I2,2X,I8,8X,F5.2) 

183  WRITE(8 , 182)  J; MJ ( J ) , DIRECT( J ) 

WRITE ( 8 , 95 ) 

DO  187  I = 1 , IMAX 
LI  I = L I ( I ) 

DO  186  L * 1.LII 

WRITE (8, 185)  L.I,GIL(L.I),L,I,EPSIIL(L,I) 

185  FORMAT( IX, 'GIL( ' , 12, ' , ' , 12, ' ) = '.E11.4.4X, 

• 'EPSIIL( ' , 12, ' , ' , 12,  ' ) = '.Eli. 4) 

186  CONTINUE 

187  CONTINUE 
WRITE ( 8 , 95  ) 

DO  200  I = 1 , IMAX 
DO  196  J = 1 , JMAX 
WRITE ( 8 , 195 ) I , J, AI J( I , J) 

195  FORMAT( IX, ' AI J( ' , 12, ' , ' , 12, ' ) = ' , E 1 1 . 4 ) 

196  CONTINUE 

200  CONTINUE 
WRITE ( 8 , 95  ) 

DO  205  1=1, IMAX+1 
DO  202  J = 1 , JMAX 

WRITE (8, 201 ) I . J.NUI J( I , J) , I , J.NUPI J ( I , J) 

201  FORMAT( IX, 'NUI J( ' , 12. ' , ' . 12, ' ) = ' , 1 5 , 9X , ' NUPI J ( ' , 12 , ' , ' , 

• 12. ' ) = ' ,15) 

202  CONTINUE 
205  CONTINUE 

WRITE ( 8 , 95 ) 

DO  225  I = 1 , IMAX 
DO  220  J = 1 , IMAX 

WRITE (8. 2 10)  I, J,SIGIK(I, J),I, J,ALPIK(I,J),I, J , BETAIK( I , J ) 

210  FORMAT( IX, 'SIGIK( ' .12, ' , ' ,12. ' ) = '.E10.4.1X, 

*'ALPIK( ' ,12, ' , ' ,12, ' ) = ' , E10.4 , IX, 'BETAIK( ' , 12, ' , ' , 12, ' ) = ', 
•E10.4) 

220  CONTINUE 
225  CONTINUE 

WRITE (8,95) 

WRITE ( 8 , 230) 

230  FORMAT (7X,25('*'),'  END  INPUT  ', 25 ('•')/// ) 

WRITE ( 8 , 23 1 ) 


231  FORMAT ( 25X, '+++  SHOCK  GEOMETRY  +++'//) 

NXPSTM  ■ NXPST  - 1 

C DEFINE  SHOCK  GEOMETRY 

CALL  SHOCKG  (NXPSTM. ITK) 

C IZTERM  « NO.  OF  DELTA  X INCREMENTS  GENERATED  IN  SHOCKG 

WRITE (8 , 95 ) 

IF  ((NXPST  - 1.0). LE. IZTERM)  GO  TO  237 
WRITE ( 15.235) 

235  FORMAT( IX. '(NXPST-1 ) . GT . IZTERM  : IT  MUST  BE  .LE.  TO  IZTERM', /. 

* IX. 'PHYSICAL  SPACE  CALCULATIONS  - SEE  DO  700  LOOP  : STOP  301'/) 

STOP 

237  WRITE (8 , 95 ) 

IF  ( IZTERM. LE. 500)  GO  TO  241 
WRITE ( 15,240) 

240  FORMAT( IX. 'IZTERM. GT.500:CHGE  DIM  OF  P.DPDX  AND  VARI : STOP  301'/) 

STOP 

C FREESTREAM  QUANITIES 

241  SUM  « 0.0 

DO  245  I > 1 . I MAX 
245  SUM  - SUM  + Cl INF ( I )/MUI ( I ) 

MUINF  « 1.0/SUM 

RHOINF  « MUINF*PINF/(R*TINF) 

AINF  « DSQRT(GAMMA*R*TINF/MUINF) 

MINF  - VINF/AINF 

C FOR  EACH  I . SPECIE 

EINF  - 0.0 
DO  275  I « 1 , I MAX 
TEM  » DEXP(THETAI (I )/TINF) 

EVIINF(I)  « ( R*THETAI (I))/(MUI(I)*(TEM  - 1.0))*FI(I) 

C FOR  EACH  L.  REACTION  LEVEL 

GSUM  « 0.0 
GESUM  * 0.0 
LI  I « LI ( I ) 

IF  (LII.LE.20)  GO  TO  255 
WRITE( 15,250)  LII 

250  FORMAT( IX. 'LII  «'.I3,2X,'A  LEVEL  IN  LI  ARRAY  IS  GREATER  THAN  20', 

* 2X , / , IX , ' YOU  NEED  TO  CHANGE  DIMENSION  OF  EPSIIL  AND  GIL') 

255  CONTINUE 

DO  285  L ■ 1 , LII 

TEM1  * DEXP( -EPSI IL( L , I )/TINF ) 

GSUM  * GSUM  + GIL(L.I)*TEM1 
GESUM  « GESUM  + GIL(L, I )*EPSIIL(L, I )*TEM1 
265  CONTINUE 

EEIINF  « R/MUI ( I ) * ( GESUM/GSUM ) 

EIINF  « 1 .5*R*TINF/MUI(I)  + FI ( I ) *R*TINF/MUI ( I ) + EVIINF(I) 

* + EEIINF  + DELHI ( I )/MUI ( I ) 

EINF  « EINF  + El INF»CI INF ( I ) 

275  CONTINUE 

WRITE( 8 , 280)  MUINF , RHOINF . AINF , TINF . PINF , VINF . MINF , El INF , EINF , 

* EEIINF 

280  F0RMAT(24X, '+++  FREESTREAM  QUANTITIES  +++',///. 6X . 'MUINF  * '.El  1.4 
«.3X, 'RHOINF  « '.Ell. 4. 3X, 'AINF  = ' , E 1 1 . 4 , // . 6X , 'TINF  = ' , E 1 1 . 4 , 3X 
* , 'PINF  « ' .E11.4.3X, 'VINF  « ' , E 1 1 . 4 , // . IX , 'MINF  « '.E10.4.2X, 

* ' EIINF  » ' .E10.4.2X. 'EINF  * ' , E 10. 4 , 2X . ' EEI INF  = '.E10.4//) 

DO  285  I « 1.IMAX 

285  WRITE ( 8 , 286 ) I.EVIINF(I) 

286  FORMAT (1X,'EVIINF(',I2,')  = '.Ell. 4) 

WRITE ( 8 . 95 ) 

C BEGIN  QUANTITIES  BEHIND  SHOCK  FOR  THE  RANGE  OF  X 

WRITE (8 , 290) 

290  F0RMAT(22X, '+++  QUANTITIES  BEHIND  SHOCK  +++',///, 5X , 'TS ', 9X ,' ES ' . 

*9X , 'PS' ,7X. 'RHOS' ,8X, ' US ' . 8X , ' PSIS ' , 8X . 'HS '/ ) 

IF  (NXPST. GE. 3)  GO  TO  293 
WRITE ( 15,291) 

STOP 

291  FORMAT( IX. 'NXPST  = 2 - SURELY  SOME  PHYSICAL  SPACE  VALUES './. IX , 

* 'ARE  DESIRED  --  MAKE  IT  AT  LEAST  3 : STOP  2') 

C 

293  DO  385  IX  = 1, IZTERM 
TEM  = SINTM(IX)*»2 
LAMBDA  = RHOINF*VINF*SINTM( IX) 

OMEGA  = PINF  + RH0INF*VINF»»2*TEM 

DELTA  = EINF  + PINF/RHOINF  + (VINF**2*TEM)/2 .0 

LAMSQ  = LAMBDA«*2 

OMEGSQ  = 0MEGA**2 

MINFSQ  *=  MINF**2 

TEM  = TEM*MINFSQ 

TSG  = (TINF*(2 .0*GAMMA*TEM  - (GAMMA  - 1 .0) )*( (GAMMA  - 1.0) 

* *TEM  + 2 .0) )/( (GAMMA  + 1.0)**2*TEM) 

TOL 1 = .001 


T0L2  - .0001 
MAXI  « 50 
C 

IF  (IQ3.EQ.1)  CALL  F0FTS1  (MAXI , TOL 1 ,T0L2 , ICODE , TSG) 

IF  (IQ3.GT.1)  CALL  F0FT23  (MAXI , TOL 1 , T0L2 . ICODE , TSG, 101 . 102 , 103 ) 

C 

IF  (ICODE. E0.1)  WRITE( 15 , 330)  TSG 
330  FORMAT (IX,'****  MAXIMUM  ITERATION  EXCEEDED  IN  FOFTS  ****',//. 

* IX , ' LAST  ITERATED  VALUE  OF  TSG  WAS  '.E15.6,'  : STOP  321'/) 

IF  (ICODE. EO. 2)  WRITE ( 15 , 335 ) 

335  FORMAT( IX, '»****  DERIVATIVE  * 0.0  IN  FOFTS  *****  : STOP  321'/) 
IF  ( I CODE . EO . 1 . OR . I CODE . EO . 2 ) STOP 

c STOP  321 

IF  (IX. EO. 1)  TSTAG  « TSG 
TS  - TSG 
ES  - 0.0 

DO  360  I - 1 , I MAX 

IF  (M.E0.1)  EVIS(I)  * EVIINF(I) 

IF  (M.EO. 1)  GO  TO  345 
TEM  - DEXP(THETAI ( I )/TS ) 

EVIS(I)  * ( R* THETA I (I))/(MUI(I)*(TEM  - 1.0))*FI(I) 

345  SUMG  * 0.0 
SUMGE  - 0.0 
LI I « LI ( I ) 

DO  350  L * 1.LII 

TEM1  * DEXP(-EPSIIL(L,I)/TS) 

SUMG  « SUMG  + TEM1 *GIL( L , I ) 

350  SUMGE  * SUMGE  + TEM1 *GI L ( L , I ) *EPSI I L( L . I ) 

EEIS  * (R/MUI ( I ) ) * ( SUMGE/ SUMG) 

EIS  * ( 1 ,5*R*TS)/MUI(I ) + (FI(I)*R*TS)/MUI(I)  + EVIS(I) 

* + EEIS  + DELHI ( I )/MUI ( I ) 

IF  (I03.EQ. 1 ) THEN 

ES  * ES  + EIS*CI INF ( I ) 

ELSE 

ES  « ES  + EIS*CID( IX , I ) 

ENDIF 

360  CONTINUE 

PS  « DSQRT(OMEGSQ  - 2 .0*LAMS0*(DELTA  - ES)) 

RHOS  « (MUINF*PS)/(R*TS) 

US  * VINF*COSTM( IX ) 

PSIS  * ( RHOINF*VINF*RSM( IX)**2)/2.0 
HS  * PS/RHOS  + ES 

WRITE (10,*)  IX .TS.ES.PS, RHOS, US. PSIS,  HS 
WRITE (8, 365)  TS , ES , PS , RHOS . US . PSI S , HS 

365  FORMAT (1X,7(E9.4,2X)) 

WRITE (9 , 366 ) IX 

366  FORMAT( IX, 'FOR  IZTERM  « ',13//) 

DO  370  I * 1 , I MAX 

WRITE(S, 367)  I,EVIS(I) 

367  FORMAT (13X,'EVIS(',I2,')  = '.Ell. 4) 

370  CONTINUE 

WRITEOl,*)  (EVIS(I).I  = 1 , I MAX  ) 

WRITE ( 9 , 620) 

385  CONTINUE 
C 

REWIND  9 
REWIND  10 
REWIND  11 

C COMPUTE  PRESSURE  DISTRIBUTION  FOR  EACH  PSI 

DO  390  IPSI  = 1. IZTERM 
DO  388  IX  - 1, IZTERM 
IF  (IX. EO. IPSI)  XX  * X1(IX) 

READ ( 10 , * ) IXT.TS.ES.PS, RHOS . US . PSI S . HS 
IF  (IXT.LT.IPSI)  GO  TO  388 
IF  ( IXT . EO. IPSI ) PSISHK  = PSIS 
IF  (IPSI. EO. IX)  THEN 
P(IX)  * PS 
GO  TO  388 
ENDIF 

P(IX)  = PS  + US/(RCM(IX)*RSM(IX))*( PSISHK  - PSIS) 

388  CONTINUE 
REWIND  10 

WRITE ( 12 , * ) XX,(P(IX),IX  = 1, IZTERM), IPSI. IZTERM 
390  CONTINUE 
REWIND  12 

C COMPUTE  DPDX  AND  VARI 

DO  404  IPSI  * 1. IZTERM 

READ( 12,*)  X, ( P( I), 1=1, IZTERM), IPI, IZTERM 
I THIS  = 0 

DO  401  IX  = IPSI. IZTERM 


oooooooooooooo 


401 

c 

402 

403 

404 

c 


405 

407 

408 


IF  (IX.EQ.IPSI)  XT  * X 

IF  (IX. GT. IPSI. AND. IPSI.  LT.( NSR+2 ) ) XT  • XT  + DELX/NSR 
IF  (IX. GT. IPSI. AND. IPSI. GT.(NSR+1))  XT  « XT  + DELX 
ITHIS  * ITHIS  + 1 
VARI(ITHIS)  * XT 
CONTINUE 

DO  403  IX  * IPSI , IZTERM 

DIFFERENTIATE 

IF  (IX. NE. IPSI)  GO  TO  402 

DPDX(IX)  - (-  3 . *P( IX ) + 4 . *P( IX+ 1 ) - P(IX+2))/(2.0*DELX) 

GO  TO  403 

DPDX(IX)  - (-  P(IX-1)  + P(IX+1))/(2.0*DELX) 

IF  (IX. NE. IZTERM)  GO  TO  403 

DPDX(IX)  * ( P( IX-2 ) - 4 . *P( IX- 1 ) + 3.*P(IX))/(2.0*DELX) 

CONTINUE 

WRITE ( 13, * ) (DPDX(I ) . 1*1 . IZTERM) , IPSI .IZTERM 

CONTINUE 

REWIND  13 

REWIND  12 


DO  405  IX  « 1, IZTERM 
IF  (IX. EO. 1)  VARI(I)  * 0.0 
IF  (IX.EO. 1 ) GO  TO  405 

IF  ( IX . LT . (NSR+2 ) ) VARI(IX)  * VARI(IX-I) 

IF  (IX.GT.(NSR+1))  VARI(IX)  « VARI(IX-I) 

CONTINUE 
WRITE ( 8 , 95 ) 

WRITE ( 8 , 407 ) ITK.NXPST 

FORMAT( IX, 'XXXXX  ITK  « ' , 1 3 , 5X . ' NXPST  « 

IF  (ITK.GE. (2*NXPST/4))  GO  TO  409 
WRITE ( 15,408) 

FORMAT( IX, 'NO.  OF  X-S  IN  XPST  ARRAY. ITK,  IS  .LT. 
* , IX, 'REEXAMINE  DELX, NXPST  AND  XPST  ARRAY 

STOP 


DELX/NSR 

DELX 


,13,'  XXXXX'//) 


. 5*NXPST ' , / 
STOP  301'/) 

STOP  301 


END  COMPUTATION  OF  QUANTITIES  BEHIND  SHOCK  ; INTEGRATE  ALONG  EACH  PSI 
VAR ( 1 ) * XVAR 

VAR ( 2 ) « H, ENTHALPY  VAR(2)  MUST  BE  H,  WHICH  MAY  BE  + OR  - 

CONCENTRATION  OF  SPECIE 

VAR(3)  * Cl ( 1 ) 

VAR( 2+IMAX ) * CI(IMAX) 

EQUILIBRIUM  VIBRATIONAL  ENERGY 

VAR ( 2+IMAX+ 1 ) * EVI ( 1 ) 

VAR(2+IMAX+IMAX)  = EVI(IMAX) 

409  WRITE (8, 411) 

411  FORMAT( IX, 'NO.  OF  VIB.  LEVELS  TO  DISSOCIATION',/) 

DO  410  I « 1 . IMAX 

C TRUNCATE 

YIY  * FI(I)*(DELI(I ) /THETA I ( I ) + 1.0) 

N I ( I ) « AINT(YIY) 

410  WRITE(8,412)  I,NI(I) 

412  FORMAT ( 11X,'NI(',I2,')  « ',13) 

WRITE (8,95) 

MU  « 0.0 

N « 1 + 2* IMAX 

IF  (M.EQ.O)  N « N - IMAX 

C INITIALIZE 

WRITE(8,415)  IZTERM 
415  FORMAT( IX, 'IZTERM  * ',14///) 

WRITE(8,417) 

417  FORMAT( IX, 'COUPLED  VIBRATION-DISSOCIATION  MODELS ',//, 1 2X , 

* 'TYPE' , 1 IX. 'NO. ' ,//,9X, 'VIB.  EQUI L . ' , 8X , ' 0' , / , 1 2X . ' CVD ' , 1 3X , 

* ' 1 ' ,/, 12X, ' CVDV ' . 12X, '2' ,/,6X, ' CVDV-Pref erent i al ' ,5X, '3' ./, 

* 12X, 'PARK' , 12X, '4'///) 

WRITE(8,418) 

418  FORMAT (7X, 'SHOCK  JUMP  CONDITION  MODELS' .//, 12X , 

* 'TYPE', 1 IX. 'NO. ' ,//,6X, 'CHEMISTRY  FROZEN' . GX ,' 1 ',/, 5X. 

* ' N2  FROZEN,  02  DI SS . ' , 4X , ' 2 ' , / , 7X , ' N2  AND  02  DISS . ' , 6X, ' 3'// ) 

IF  (MW . EQ . 1 . AND . IMAX . EQ . 7 ) THEN 
WRITE (8, 419) 

419  F0RMAT(3X, 'MILLIKAN  AND  WHITE  DATA  FOR  N2  WAS  SELECTED'/) 

END  IF 

IF  (MW.EQ. 1 .AND. IMAX.EQ. 10)  THEN 
WRITE ( 8 , 426 ) 

426  F0RMAT(3X, 'MILLIKAN  AND  WHITE  DATA  FOR  N2  AND  N2+  WAS  SELECTED'/) 
END  IF 


KSTAG  = 0 
ISTAG  « 0 
XPST ( 1 ) » DELX 

XPST(NXPST)  * VARI ( IZTERM)  + 100.0 
SUMCI  « 0.0 
WRITE (8 , 95 ) 

LPS1  ■ 1 
IPSI  - 0 

C BEGIN  EACH  STREAMLINE  COMPUTATION  HERE 

420  IPSI  » IPSI  + 1 

IF  (IPSI. EO. IZTERM)  GO  TO  735 
425  KIPF  - 0 

C ISTAG  = 2 FOR  STREAMLINE  DELX 

IF  (ISTAG. EO. 1 ) ISTAG  ■ 2 
READ( 10,*)  IX.TS.ES, PS. RHOS , US , PSIS , HS 
READ(11,*)  (EVIS(I).I  ■ 1 , I MAX ) 

IF  (IPSI .EO. 1)  HSTAG  - HS 
CJ  - XI 
SPEC  - 0.0 

C EVALUATE  DERIVATIVES  WHEN  SPEC  = 0.0 

II  - 0 

C USE  SHOCK  VALUES  FOR  INITIAL  COMPUTATION  ON  EACH  STREAMLINE 

KEYINT  ■ 0 
IX  = 0 
T • TS 

IF  (M.EO.O)  GO  TO  450 
DO  445  1=1, IMAX 
445  TVI(I)  » TINF 
TE  1 =TINF 
GO  TO  460 

450  DO  455  1=1. IMAX 
455  TVI(I)  = TS 
TE 1 =TINF 
460  RHO  - RHOS 

IF  (IQ3.GT.1)  THEN 
SUM  =0.0 
DO  462  1=1. IMAX 

462  SUM  = SUM  + CID( IPSI , I )/MUI ( I ) 

MU  = 1 . O/SUM 
ENDIF 

IF  (103. EO. 1 ) MU  = MUINF 
U = US 

DO  465  1=1, IMAX 
MM  = 2 + I 
K = IMAX  + MM 
VAR (MM)  = 0.0 

IF  (IQ3.EQ.1)  VAR (MM)  = CIINF(I) 

IF  (IQ3.GT.1)  VAR(MM)  = CID(IPSI.I) 

VAR(K)  = 0.0 

IF  (M.EO.O)  VAR(K)  = EVIS(I) 

IF  (M.E0.1)  VAR(K)  = EVIINF(I) 

EVI(I)  = VAR ( K ) 

465  CONTINUE 

C COMPUTE  S EXPONENT  FOR  PARK  MODEL 

IF  (MODEL. EO. 4)  THEN 
SP  = 3.5*DEXP( -5000 . O/TS ) 

ENDIF 
E = ES 
H = HS 

IF  ( (IPSI . EO. (NSR+1 )) .AND . (ISTAG. EO.O) ) GO  TO  635 
READ( 12, *)  X,(P(L),L=1, IZTERM) , IPSI , IZTERM 
READ( 13, *)  (DPDX(L)  , L=1 , IZTERM) , IPSI , IZTERM 
VAR( 1 ) = X 

C OMIT  PSI  = 0.0  STREAMLINE  FOR  NOW  - PICK  IT  UP  LATER 

IF  (X.NE.O.O)  GO  TO  490 
IG  = 0 

WRITE(8, 725) 

GO  TO  730 

490  IF  (IANS.EQ. 1 ) THEN 

IF  ((IPSI. EQ.IS1). OR. (IPSI. E0.IS2). OR. (IPSI. E0.IS3))  GO  TO  492 
IF  ( (IPSI . EO. IS4)  .OR . (IPSI . EO. IS5) .OR. ( IPSI . EO. IS6) ) GO  TO  492 
GO  TO  730 
ENDIF 

492  IF  (DABS(X  - VARI ( IPSI )). LE . 1 . 0E-06 ) GO  TO  500 
WRITE( 15,495)  IPSI , X , VARI ( IPSI ) 

495  FORMAT( IX, ' IPSI  = ',I3,2X,'X  = ' , E 10. 5 , 2X . ' VARI ( IPSI ) = '.E10.5, 

*//,1X,'X  AND  VARI ( IPSI ) SHOULD  BE  EQUAL  : EXAMINE  GENERATION  OF  X 
* AND  VARI  IN  MAIN  : STOP  663'/) 

STOP 

C STOP  663 


o o o o o 


c 


c 

c 


c 


c 

c 


INITIALIZE 

500  IF  (IANS.EO. 1)  THEN 

IF  ( ( IPSI . EO . IS  1 ) . OR . (1PSI . EO . IS2 ) . OR . ( IPSI . EO . IS3) ) GO  TO  501 
IF  ((IPSI. E0.IS4). OR. (IPSI. EQ.IS5). OR. (IPSI. EQ.IS6))  GO  TO  501 
GO  TO  730 
END  IF 

501  E LB  = 0.0 
SPEC  * 0.0 

IF  (VAR(I).GT.XPST(LPSI))  LPS1  ■ LPS 1 + 1 
LPS2  - LPS1 
505  IX  « IX  + 1 

CALITH  - MODIFIED  RUNGE-KUTTA 

CALL  CALITH  ( N , C I MAX , PHMAX ) 

IF  (NERR.EO.O)  GO  TO  575 
IF  (NERR.E0.1)  WRITE( 15,565)  Cd.N 

565  FORMAT ( IX, 'BAD  INPUT  IN  CALITH' ./, IX. 'Cd  = ' . E 10 . 5 . 2X , ' N • '.14 
* ./.IX. 'STOP  665'/) 

IF  (NERR.E0.2)  WRITE( 15 , 570) 

570  FORMAT( IX, ' EXAMINE  ELE 1 AND  ELE2  IN  CALITH  : STOP  665'/) 

IF  ((NERR.EQ. 1 ) .OR. (NERR.EQ.2))  STOP 

STOP  665 

575  IF  (IX. EO. 1 ) THEN 

IF  (I03.NE.1)  THEN 
IF  (102. EO. 1 ) TE  = TINF 
IF  (102. EO. 2)  TE  « TS 
TE 1 = TE 
TE2  « TE 
ELSE 

TE  = TINF 
TE 1 ■ TE 
TE2  = TE 
END  IF 
END  IF 

ELECTRON  TEMPERATURE  MODEL 

IF  (IX. EO. 1 ) GO  TO  576 
CORR  = 4 . 23E-06* (T**(-2.88) ) 

CN  = RH0*6 . 02252E+23 
CNN  - CN*VAR ( 5 )/MUI ( 3 ) 

CNO  = CN*VAR(6)/MUI (4) 

TE  - DLOG( 1 . + 10. l/( (CNO+CNN)*CORR) ) 

TE  = T/( 1 . + TE*T/85000. ) 

TE  1 = TE 
ITRTE=0 

FNA=CN*VAR(5)/MUI(3) 

FNI =CN*VAR( 1 1 )/MUI ( 9 ) 

FNE  =CN*VAR ( 9 ) /MUI ( 7 ) 

FNM=CN*VAR( 3 )/MUI ( 1 ) 

F0A=CN*VAR(6)/MUI(4) 

FOI =CN*VAR( 1 2 )/MUI ( 10) 

F0M=CN»VAR(4)/MUI(2) 

El =2 . 3322D- 1 1 

E0  = 2. 17350-11 

FAV=6. 023023 

SA=1 .52D-15 

F 1 =0 

F2=0 

F0=0 

574  ITRTE=ITRTE+ 1 

I F ( ITRTE . GT . 1 )G0  TO  571 
KK=  1 

569  KK=KK+ 1 

I F ( KK . GT . 50 )TE 1 =2000 . DOO 
I F ( KK . GT . 50 ) GO  TO  576 
TE=1000*KK 

571  SM=0.5355D-19*TE+. 696D- 15 
I F ( ITRTE . GT . 5O)G0  TO  573 
S I = 1 . 536 14D08* (TE**3 )/FNE 
SI =DSORT (SI ) 

SI = ( ( 4 . 38384D-06 )/(TE**2)) *DLOG( SI ) 

FKF=4 . 16D13*(TE**(  0.50D0) )*DEXP ( - 1 . 20D05/TE ) 

FK1=5 .49D13*(TE**(  0.50D0) )*DEXP(-1 .045005/TE) 

FKB=2.3D21*(TE**(-1 . ODOO) ) *DEXP( 4 . 9D4/TE ) 

FK5= 1 ,53D22*(TE**(-1 . ODO) ) *DEXP ( 5 . 3D4/TE ) 

WEA=FKF*FNA-FKB*(FNI/FAV)*FNE 

W2E=FK1 *F0A-FK5* ( FOI/FAV )*FNE 

SX= ( FNA+FOA )»SA+(FNI+FOI)*SI+( FNM+FOM)/ ( 2 . ODO)*SM 
W2=DER(8) *U*FAV/VAR ( 9 ) 

W 1 =WEA+W2E 
W1=W2 


FE«T-1 . 23357D- 10/SX/DSQRT(TE )* ( WEA*EI+W2E*E0+W1 *3 ,45D-16*TE)-TE 

IF( ITRTE . GT . 1 )G0  TO  568 

IF ( ( F E/DABS ( FE )*FO) . LT . O. DOO)GO  TO  567 

FO-FE 

TO«TE 

GO  TO  569 

567  F1-FE 
T1-TE 

566  TE«(TO*F1-T1*FO)/(F1-FO) 

I F (DABS(TE-T 1 ) . LT . 1 .DOO) GO  TO  573 
I F (DABS(TE-TO) . LT . 1 .000) GO  TO  573 
GO  TO  574 

568  I F ( ( FE/DABS( FE ) *FO/DABS( FO) ) . LT . 0 . ODOO)GO  TO  564 
TO«TE 

FO*FE 
GO  TO  566 
564  F1«FE 
Tl'TE 
GO  TO  566 

573  IF(TE.GT.T)TE«T 
C 573  CONTINUE 
TE1-TE 

IF( ITRTE. GT.50)WRITE(6. 572) 

572  FORMAT ( ' ' . 'TE  DID  NOT  CONVERGE') 

CN2  * RHO  *6 . 02252E+23*VAR( 3 )/MUI ( 1 ) 

A - DLOG ( 1 . 01D+01 ) - DLOG ( CN2 ) - DL0G(6 . 4D+00) 

* - 59. *DLOG( 1 .00+01 ) + 19 . *DLOG(TVI ( 1 ) ) 

A « DEXP(A) 

TE  * DL0G(1.  + A) 

TE  « TVI ( 1 )/( 1 . + TE*TVI( 1 )/85000. ) 

TE2  * TE 
C 

576  IF  (IX.EQ.1)  GO  TO  580 

IF  ( (IPSI -EO. (NSR+1 )) .AND. (IX. EO. (NSR+1 ) ) ) GO  TO  580 
IF  (VAR( 1 ) .GE . VARI ( IZTERM) ) GO  TO  580 

IF  ((IPSI .LT. (NSR+1 )) .AND. (VAR( 1 ) .GE.DELX) ) GO  TO  580 
KIPF  * KIPF  + 1 
IF  (KIPF.NE.IPF)  GO  TO  625 
KIPF  = O 
580  SUMCI  *=  0.0 

DO  590  I SUM  * 3.IMAXP2 

IF  (VAR(ISUM) .LT.O.O)  NEG  = -1 

IF  (VAR(ISUM) .LT.O.O)  WRITE ( 1 5 , 585 ) 

585  FORMAT  ( 5X  , ' NEGATIVE  Cl '/) 

590  SUMCI  = SUMCI  + VAR(ISUM) 

DO  595  ICM  « 1 , I MAX 
595  CM ( ICM)  « VAR( ICM+2)*MU/MUI (ICM) 

C PRINT  ANSWERS 

WRITE (8. 600)  IPSI , IX , 103 . MODEL , XVAR . H , MU . PFTL , RHO , U . T , E , SPEC , SUMCI 

600  FORMAT( IX, 'PSI  * ',I4,3X,'IX  = 14 , 8X SHOCK  U COND . = '.I2.14X, 

*'CVD  MODEL  « ' ,12,//, IX, 'X  = ',D9.4,2X,'H  « ' , D9 . 4 , 2X , ' MU  = 

*E9 . 4 , 2X , ' P = ' , E9.4.3X, 'RHO  = ' , E9 . 4 , // , 1 X , ' U « ',E9.4,2X,'T  = ', 
*E9.4,2X,'E  « ' .E9.4.2X, 'CIT  « ' , E9 . 4 , 2X , ' SUMCI  « ',E9.4/) 

IF  (107. EO. IPSI)  THEN 
WRITE ( 15,601 ) XVAR, T, CM(2 ) ,CM(4) .SPEC 

601  FORMAT ( IX , E9 . 4 , 2X , E9 . 4 , 2X , E9 . 4 , 2X  , E9 . 4 , 2X  , E9 . 4 ) 

ENDIF 

DO  603  I - 3 , IMAXP2 
J * I - 2 

603  WRITE (8 , 605 ) J , VAR(  I ) , <J , CM(U) , J , VAR ( IMAX+I ) 

605  FORMAT (6X ,'CI(',I2,')  « ' ,D1 1 . 4 ,4X, ' CM( ' , 12, ' ) = '.E11.4.4X, 

* ' EVI ( ' . 12, ' ) = ' ,D1 1 .4) 

WRITE (8 , 620) 

620  FORMAT(/) 

DO  621  I = 1.IMAX 
IF  (EVI(I).EO.O.O)  TVI ( I ) « 0.0 
IF  (I.EQ.IMAX)  THEN 
WRITE (8, 623)  I , TVI ( I ) , TE 1 , ITRTE , W1 
GO  TO  621 
ENDIF 

WRITE (8 , 622 ) I,TVI(I) 

621  CONTINUE 

622  FORMAT ( 5X , ' TVI ( ' , 12 , ' ) = '.Eli. 4) 

623  FORMAT ( 5X , 'TVI ( ' , 12 , ' ) = ' . El  1 .4 , IX, 'TE1-  ', Ell. 4, IX, 

* ' ITRTE= ' ,12, IX, 'W1*' , E 10 . 3 ) 

WRITE (8 , 620) 

IF  (NEG.E0.-1)  WRITE( 15.630) 

C STORE  INFO  FOR  DISSPLA 

625  IF  (IPSI .E0.IS7)  THEN 
DO  626  ICM  = 1.IMAX 


oo  ooo  noo 


626  CM(ICM)  « VAR ( ICM+2 ) *MU/MUI ( ICM) 

WRITE(70, * ) ( CM( I ) , I • 1 , 1 MAX ) 

WRITE ( 71,*)  T,TVI(1).XVAR,TE1 
END  IF 

630  FORMAT ( IX , ' A NEGATIVE  CONCENTRATION  , Cl  IN  MAIN  : STOP  670'/) 

IF  (NEG.E0.-1)  STOP 

STOP  670 

WHEN  IPSI  « (NSR+1),  DELX  AND  STAGNATION  STREAMLINES  WILL  BE  COMPUTED 

IUNEG  « 1 IF  U**2  NEG.  IN  BASIC 

IF  (IUNEG.EQ.1)  GO  TO  735 

IF  ((IPSI. LT. (NSR+1)). AND. (VAR(I).LT.XPST(I)))  GO  TO  505 
IF  ((ISTAG. EQ.1). OR. (ISTAG. EC. 2))  GO  TO  690 

ISTAG  ■ 0 UNTIL  AFTER  EXTRAPOLATION  FOR  PSI  * 0.0  STREAMLINE 
ISTAG  « 1 FOR  PSI  « 0.0  STREAMLINE 
ISTAG  * 2 FOR  DELX  STREAMLINE  AND  THEREAFTER 

635  IG  ■ IG+1 
IGC  « 0 
IGE  » IMAX  + 2 
PSIG(IG)  » PSIS 
DO  640  IG1  « 3 , IMAXP2 
IGC  « IGC  + 1 
CIG(IGC.IG)  « VAR(IGI) 

IGE  » IGE  + 1 
EIG(IGC.IG)  ■=  VAR(IGE) 

640  CONTINUE 

EG(IG)  » E 
TG(IG)  » T 
HG(IG)  = H 

IF  ( IPSI . LT. (NSR+1 ) ) WRITE ( 8 , 725 ) 

IF  ( IPSI . LT. (NSR+1 ) ) GO  TO  730 

IPSI  = (NSR+1)  IS  THE  STAGNATION  STREAMLINE  ; 

AT  DELX  .EXTRAPOLATE  FOR  PSI  ■ 0.0  VALUES 

PSI  - 0.0 
MG  ■ 1 

CALL  FTLUP  ( PSI . E . MG . IG . PSIG , EG ) 

CALL  FTLUP  ( PSI , T , MG, IG. PSIG . TG) 

CALL  FTLUP  ( PSI . H, MG. IG. PSIG, HG) 

DO  650  IG2  “ 1 , IMAX 
DO  645  IG1  « 1 , NSR 1 
CIT(IGI)  « CIG( IG2 , IG1 ) 

645  EIT(IGI)  = EIG( IG2 . IG1 ) 

CALL  FTLUP  ( PSI , Cl ( IG2 ) ,MG . IG . PSIG, CIT ) 

IF  (CI(IG2) .LT.O.O)  Cl ( IG2 ) = 1 .0E-08 
CALL  FTLUP  ( PSI , EVI ( IG2 ) , MG. IG. PSIG , EIT) 

650  VAR (2+IMAX+IG2 ) = EVI(IG2) 

C INITIALIZE  FOR  PSI  = 0.0  STREAMLINE 

CJ  * XI 

SPEC  « 0.0 

II  * O 

KEYINT  « 0 

IX  - 0 

SUM  = 0.0 

DO  660  I * 1 , IMAX 

SUM  - SUM  + Cl ( I )/MUI ( I ) 

IF  (EVI(I).EQ.O.O)  TVI(I)  = 0.0 
IF  (EVI (I ) .EQ.O.O)  GO  TO  660 

XL  = ( ( DGENI (I)*R*THETAI(I))/(MUI(I)*EVI(I))  + 1.0) 

ALN  = DLOG(XL) 

TVI(I)  = THETAI ( I )/ALN 
660  CONTINUE 

MU  = 1 .O/SUM 

U = DSQRT(2.0*(HSTAG  - H) ) 

VAR ( 1 ) = DELX 

C COMPUTE  P AND  DPDX  AT  IPSI  * (NSR+1)  (AT  THE  BODY) 

IF  (IANS.EQ.O)  WRITE ( 8 , 665 ) 

IF  ( ( IPSI . EO . IS  1 ) . OR . (IPSI .EO. IS2) .OR. (IPSI .EO. IS3))  WRITE (8, 665) 

IF  ((IPSI .EQ.IS4). OR. (IPSI .EQ.IS5). OR. (IPSI. EQ.IS6))  WRITE (8. 665) 

665  FORMAT ( IX , ' PSI  » 0.000  STREAMLINE  --'/) 

P(NSR+1 ) = PS  + US/(RCM(NSR+1 )*RSM( NSR+ 1 ) ) * ( -PSI S ) 

RHO  = P(NSR+1 )/(H  - E) 

NSR2  = NSR  + 2 

DO  670  I = NSR2, IZTERM 

READ( 10. *)  IXT. TS.ES.PS, RHOS, US, PSIS. HS 
670  P(I)  = PS  + US/ ( RCM( I )*RSM (!))*(-  PSIS) 

REWIND  10 
REWIND  11 

DPDX (NSR+ 1 ) = (-3.*P(NSR1 )+4 . *P ( NSR2 ) -P ( NSR+3 ) )/(2. *DELX) 

C EVALUATE  DPDX  FROM  (NSR+2)  TO  IZTERM 

DO  680  I = NSR2 , IZTERM 


o o 


IF  (I  . LT . IZTERM)  THEN 
DPDX(I)  • (-  P(I-1)  + P(I+1))/(2.*DELX) 

ELSE 

DPDX(I)  « ( P( I -2 ) - 4 . *P( I- 1 ) + 3.*P(I))/(2.*DELX) 

ENDIF 

680  CONTINUE 

DO  685  I » 1.NSR 

READ( 10,*)  IX.TS.ES, PS, RHOS, US, PSIS.HS 
685  READ(  11,*)  (EVIS(J),J  * 1.IMAX) 

ISTAG  ■ 1 
PSIS  « 0.0 
GO  TO  500 

AT  EACH  X WHERE  PHYSICAL  SPACE  CALCULATIONS  ARE  DESIRED  SAVE 

1./(RH0*U)  ON  EACH  STREAMLINE 

690  IF  (XPST(LPS2).EQ.XPST(1))  ICNT  « 1PSI 
JJJ  - IPSI  - ICNT  + 1 

IF  ( VAR( 1 ) . LT . XPST ( LPS2 ) ) GO  TO  720 
IF  (VAR ( 1 ) .GT.XPST(LPS2) ) GO  TO  705 

VAR ( 1 ) « XPST ( LPS2  ) 

RHOURT  » 1 . 0/( RHO*U ) 

TEMP( LPS2 , UUU ) - TVI(1) 

TEMPO ( LPS2 , JJJ ) ■ T 
DO  691  III  • 1 , I MAX 

691  RCON( LPS2 , I I I , UJU ) » VAR(III+2) 

RRHO( LPS2 , UUU ) ■ RHO 

WRITE ( 14.  *)  IPSI .RHOURT, VAR ( 1 ) ,PSIS 
GO  TO  715 

705  YPSIS  « PREPSI  + (XPST(LPS2)  - PREX)*((PSIS  - PREPSI)/ 

* ( VAR ( 1 ) - PREX)) 

RHOURT  « PRERU  + (XPST(LPS2)  - PREX ) * ( ( RHO*U  - PRERU)/ 

* ( VAR ( 1 ) - PREX)) 

TEMP(LPS2,UJJ)  « PRETMP  + (XPST ( LPS2) -PREX) *( (TVI ( 1 ) -PRETMP )/ 

* ( VAR ( 1 ) - PREX)) 

TEMPO ( LPS2 , JUJ)  « PRET  + ( XPST( LPS2 )-PRET )*( (T-PRET )/ 

* ( VAR ( 1 ) -PRET ) ) 

DO  706  III  ' 1.IMAX 

706  RCON( LPS2.III.JJJ)  = PREC( 1 1 1 ) + ( XPST( LPS2 ) -PREX ) * ( ( VAR( 1 1 1+2 ) 

* -PREC(III))/(VAR(1)-PREX)) 

RRH0(LPS2, JUJ)  * PRERHO  + ( XPST (LPS2) -PREX )*( (RHO-PRERHO)/ 

* (VAR(  1 ) - PREX)) 

RHOURT  = 1 . O/RHOURT 

WRITE ( 14,*)  IPSI .RHOURT, XPST (LPS2) .YPSIS 
715  LPS2  « LPS2  + 1 
KSTAG  ■ KSTAG  + 1 

720  PREX  = VAR( 1 ) 

PRERU  « RHO*U 
PREPSI  « PSIS 
PRETMP  » TVI ( 1 ) 

PRET  - T 

DO  721  III  = 1 .IMAX 

721  PREC (III)  « VAR ( 1 1 1 + 2 ) 

PRERHO  » RHO 

IF  ( VAR ( 1 ) . LT . VARI ( I ZTERM ) ) GO  TO  505 
C END  OF  STREAMLINE 

WRITE(8, 725) 

725  FORMAT ( IX. ' XXXXXXXXXXXXXXXX ' / ) 

IF  (( IPSI . EO. (NSR+1 )) .AND. (ISTAG. EQ. 1 ) ) GO  TO  425 
730  GO  TO  420 

C COMPUTE  PHYSICAL  SPACE  VALUES 

735  REWIND  10 
REWIND  11 
REWIND  12 
REWIND  13 

WRITE ( 8 , 740)  KSTAG 

740  FORMAT( IX, 'BEGIN  PHYSICAL  SPACE  CALCULATIONS  KSTAG  = ',15/) 

C 

LPS3  = 0 
IXSTR7  = 0 

DO  840  LPS  = 1 , NXPST 
REWIND  14 
IK  = O 

745  LPS3  = LPS3  + 1 

IF  (LPS3.GT. IZTERM)  GO  TO  840 

IF  ( DABS(X 1 ( LPS3 ) - XPST(LPS)).GT. 1.0E-08)  GO  TO  745 

DO  780  IPS  = 1, KSTAG 

READ ( 14,*)  I PS I. RHOURT. VAR (1 ) ,PSIS 

VARMX  * VAR( 1 ) - XPST ( LPS ) 

IF  ( DABS (VARMX ) . GT . 1 . 0E-08 ) GO  TO  780 
IK  = IK  + 1 

IBOB  - IK  - 1 L-.LI 


o o 


13) 


IF  (IK.GT.200)  WRITE( 15,770)  IK 

770  FORMAT ( IX. 'IK.GT.200, CHANGE  DIMENSION  OF  RUT  AND  PSISTG.IK  « ', 

RUT (IK)  - RHOURT 
PSISTG(IK)  « PSIS 
780  CONTINUE 

C FIND  SMALLEST  DELTA  PSI 

SMALL  * 200.0 
DO  785  I « 2, IK 

IF  ((PSISTG(I)  - PSISTG(I-1 )) . LT . SMALL)  SMALL  ■=  PSISTG(I) 

* - PSISTG(I-I) 

785  CONTINUE 

XDEL  * PSI STG( IK )/SMALL 

C TRUNCATE 

L « INT(XDEL  + 1 .0) 

C REMAINDERING  M = 0 FOR  EVEN.  M « 1 FOR  ODD 

M « MOD( L , 2 ) 

C MAKE  L EVEN 

IF  (M.NE.O)  L « L + 1 

FIND  INTEGRAL  1./(RH0*U)  DELTA  PSI  FROM  BODY  TO  SHOCK 
USING  SIMPSONS  RULE  : L INCREMENTS  . L+1  POINTS 

FL  « L 

DPSIS  « PSI STG( IK )/FL 
PSII  « 0.0 

RB  « RUT ( 1 ) + RUT ( IK ) 

DO  800  I - 2 , L , 2 
PSII  » PSII  + DPSIS 

CALL  FTLUP  ( PSI I , RU 1 . 1 , IK . PSI STG . RUT ) 

IF  (I.EO.L)  RB  ■ RB  + 4.0*RU1 
IF  (I.EO.L)  GO  TO  800 
PSII  * PSII  + DPSIS 

CALL  FTLUP  ( PSI I , RU2 , 1 , IK , PSISTG , RUT ) 

RB  » RB  + 4 . 0*RU 1 + 2.0*RU2 
800  CONTINUE 

RB  » RB*DPSIS/3 .0 

ARR  ■ DSORT (RSM(LPS3)**2  - 2 . 0*COSTM( LPS3 )*RB ) 

YI  » ( RSM( LPS3 ) - ARR )/COSTM( LPS3 ) 

YBDY(IBOB)«YI 

ZE  « ZSM( LPS3 ) + YI *SINTM( LPS3 ) 

WRITE (8, 8 15)  PSI STG( 1 ) , X 1 ( LPS3 ) , ARR , YI . ZE 
815  FORMAT( IX, 'PSI  - ' , E 1 2 . 5 . / . IX . ' X - ' . E 1 3 . 6 , 3X , ' R « '.E13.6 

* , 3X , ' Y « ' .E13.6.3X, 'Z  * '.E13.6/) 

C STORE  BODY  PTS.  FOR  DISSPLA 

WRITE ( 72 , * ) ZE , ARR 
C 

DO  830  I * 2, IK 

DPSI  ■ PSISTG(I)  - PSISTG(I-I) 

C TRAPEZOIDAL  RULE 

TR  « (DPS 1/2 . 0) * ( RUT ( I ) + RUT(I-I)) 

RB  * RB  TR 

ARR  ■ DSORT (RSM(LPS3)**2  - 2 . 0*C0STM( LPS3 ) «RB ) 

YI  - ( RSM( LPS3 ) - ARR )/COSTM( LPS3 ) 

Y ( I BOB , I - 1 ) * YI 

ZE  * ZSM( LPS3 ) + YI *SINTM( LPS3 ) 

WRITE(8,815)  PSISTG(I).X1 (LPS3),ARR, YI.ZE 
C STORE  STRLNE  AND  SHOCK  COORD.  FOR  DISSPLA 

IF  (I .EO.IK)  THEN 
IF  ((I+NSRM1).EQ.IS7)  THEN 
IXSTR7  « IXSTR7  + 1 

WRITE ( 73 , * ) ZSM(IS7),RSM(IS7),X1(IS7) 

XSTR1 ( IXSTR7 ) « X1(IS7) 

ZSTR1 ( IXSTR7  ) = ZSM(IS7) 

RSTR1 ( IXSTR7  ) = RSM(IS7) 

END  IF 

WRITE ( 74 , * ) ZE , ARR 
GO  TO  830 
END  IF 

IF  ( ( I+NSRM1 ) . EO . IS7 ) THEN 
IXSTR7  = IXSTR7  + 1 
WRITE ( 73 , * ) ZE , ARR , X 1 ( LPS3 ) 

XSTR 1 ( IXSTR7 ) = X1(LPS3) 

ZSTR1 ( IXSTR7 ) = ZE 
RSTR1 ( IXSTR7)  = ARR 
ENDIF 
C 

830  CONTINUE 

WRITE ( 8 , 835 ) 

835  FORMAT ( // ) 

840  CONTINUE 


C 


STRL1  = 0.0 


INTERPOLATE  X COORD.  TO  DETERMINE  (Z,R)  AND  XS 


o o o o o o o 


PRER11  « 0.0 
PREZ11  » 0.0 
PRESTL  - 0.0 
REWIND  71 

841  READ( 7 1 , * , END“842 ) T 1 1 . TVN2 1 , XS 1 . TE 1 
CALL  FTLUP  ( XS 1 , R 1 1 . 2 , IXSTR7 . XSTR 1 . RSTR 1 ) 

CALL  FTLUP  (XS 1 . Z 1 1 , 2 . IXSTR7 , XSTR 1 . ZSTR 1 ) 

SEG  « DSQRT ( ( PRER 1 1 - R11)**2  + (PREZ11  - Z11)**2) 

IF  (XS 1 . EO . X 1 ( IS7  ) ) SEG  * 0.0 

STRL1  « PRESTL  + SEG 

WRITE ( 75 , * ) XS1.Z11.R11, STRL 1 

PRESTL  - STRL 1 

PRER 1 1 « R 1 1 

PREZ11  « Z11 

GO  TO  841 

C RADIATION  MODELS 

842  IF  (IQ4.E0.0)  GO  TO  845 

IF  (I05.E0.O)  WRITE(6.9191) 

9191  FORMAT ( /// , ' NONEOUILIBRIUM  RADIATION  MODELS',///) 

IF  (I04.E0.1)  CALL  OLRAD  (104,105,106,108.109,1010) 

IF  (104. EO. 2)  CALL  CARRAD  (104,105,109) 

IF  (104. EO. 3)  CALL  CORRAD  (104,105,106,108.109) 

IF  (104. EO. 4)  CALL  ANDRAD  (104,105,109) 

IF  ((104. EO. 5) .OR. (104. EO. 6))  THEN 
CALL  OLRAD  (104,105,106,108,109,1010) 

CALL  CARRAD  (104,105,109) 

CALL  CORRAD  (104,105,106,108,109) 

CALL  ANDRAD  ( 104 . 105 . 109 ) 

ENDIF 

C IF  (I05.E0.0)  THEN 

DO  1920  K = 3.NXC0N 
WRITE(8, 191  1 ) XPST(K) 

DO  1920  d = 1 , NPTS ( K ) 

WRITE (8, 1921  ) U,ALPN(K,d) ,ALPO(K, d) ,BETN(K, J) ,BETO(K, d) 
1921  FORMAT ( ' J = '.12,'  An  = ',011.4,'  Ao  - ' , D 1 1 . 4/ 

* ' ' , 2X , ' BN  * '.Dll. 4,'  BO  = '.Dll. 4) 

1920  CONTINUE 
C ENDIF 

DO  19'12  K = 3 , NXCON 
WRITE ( 8 , 1911  ) XPST(K) 

1911  FORMAT ( /// , ' AT  X = '.D11.4,///) 

DO  1912  J = .1  ,NPTS(K) 

WRITE(8, 1913)  U , TEMP(K , d ) , RRHO ( K , U ) , TEMPO (K , d ) 

1913  FORMAT ( ' d=',I2,'  TE«',F10.2,'  RHO= ' ,D1 1 . 4 , ' T=',F10.2) 

1912  CONTINUE 

DO  1918  K = 3. NXCON 
WRITE(8, 1911)  XPST(K) 

DO  1918  d = 1 ,NPTS(K) 

WRITE(8, 1914)  d 

1914  FORMAT ( / , ' AT  d - ',12,'  NUMBER  DENSITIES  ARE  ',/) 

DO  1918  I = 1.IMAX 

WRITE(8 . 1915)  I , RCON(K, I , d) 

1915  FORMAT ( ' SPECIES  * ',12,'  N * '.D11.4) 

1918  CONTINUE 

WRITE ( 8 , 835 ) 

845  WRITE ( 8 , 850) 

850  F0RMAT(1X, 'END  THIS  CASE  , HALLELUdAH  '/) 

REWIND  8 
REWIND  14 
STOP 
END 


SUBROUTINE  BASIC 

BASIC  CALLED  BY  CALITH  TO  EVALUATE  DERIVATIVES  H DOT, 

C SUB  I DOT  AND  EV  SUB  I DOT  ; DERIVATIVES  START  IN  DER( 1 ) 

IMPLICIT  REAL*8(A-H,0-Z) 

COMMON  /A  1/  TE1 ,TE2,M, IX, IMAX, IPSI .MODEL 
COMMON  / A2/  P ( 500 ) , DPDX ( 500 ) , VAR I ( 500 ) 

COMMON  /A3/  EVIINF(25) , THETA I (25),MUI(25),FI(25),DELHI(25), 
CIINF(25) ,LI(25) 

COMMON  /A4/  R.MUINF, DELTA, LAMSO , OMEGSO , OMEGA, MU, T.U.TINF 
COMMON  / A5/  EPSIIL(20,25) ,GI L( 20 , 25 ) , CID( 200 , 50) 

COMMON  / A6/  VAR( 52 ) , CUVAR (52) ,DER(51 ) 

COMMON  /A7/  Md ( 50) , Ed( 50) , Ad ( 50) ,Bd(50) ,DIRECT( 50) 

COMMON  / A8/  TVI(25) ,DGENI(25) ,BI(25) ,NI(25) 

COMMON  /A  10/  NUId(26,50) , AId(25,50) , NUPI d( 25 , 50) 


COMMON  /All/  SIGIK(25.25) , ALPIK( 25 , 25 ) , BETAIK( 25 . 25 ) 

COMMON  /A  1 3/  SP.TS.DELX.ZSTERM, I ZTERM, NSR . MW 

COMMON  /A  1 4/  EINF , PINF , RHOINF , VINE , E , JMAX , KEY I NT , RHO, HSTAG 

COMMON  /A  1 5/  PFTL.KITR1 ,NIP(25) ,UP(25) 

COMMON  /A  16/  WE(25) ,WEXE(25) ,WEYE(25) ,WEZE(25) , IUNEG 
COMMON  /A18/  ITNEG.IEXP 

DIMENSION  PHI(50) ,SJ(50) ,DCIJDX(50) ,EVP( 100) 

DIMENSION  CI(25),EVI(25),DCIDX(25),DEVIDX(25),EVIBAR(25) 

EQUIVALENCE  (CUVAR(2) ,H) , (CUVAR( 3 ) , Cl ( 1 ) ) 

EQUIVALENCE  (DER( 1 ) , DHDX ) , ( DER ( 2 ) , DCIDX( 1 ) ) 

REAL  *8  KP J , KEQ, KU(50) , LAMSQ, MU , MU I , MUIOT , MUINF , ND 
C 

C DER(  1 ) ■ DHDX  MUST  BE  DHDX  AS  H MAY  BE  + OR  - 

C DER( 2 ) - DCIDX ( 1 ) 

C - 

C DER( 1+IMAX ) « DCIDX(IMAX) 

C DER( 1 + IMAX+1  ) « DEVIDX ( 1 ) 

C DER( 1+IMAX+IMAX)  = DEVIDX(IMAX) 

C - 

C CUVAR(I)  « X 

C CUVAR ( 2 ) » H, ENTHALPY  - IT  MUST  BE  H WHICH  MAY  BE  + OR  - 

C CUVAR ( 3 ) = CI(1) 

C - - 

C CUVAR ( 2+ I MAX ) « CI(IMAX) 

C CUVAR ( 2+IMAX+ 1 ) - EVI ( 1 ) 

C CUVAR( 2+IMAX+IMAX ) « EVI(IMAX) 

C 

C KEYINT  = 1 AT  END  OF  1ST  INTERVAL 

IF  (ITNEG.EQ. 1 .OR.IEXP.EQ. 1 ) RETURN 
IF  (M.NE.O)  GO  TO  10 
DO  5 I ' 1 ,IMAX 
J1  = I + IMAX  + 2 
5 CUVAR ( J 1 ) = VAR(UI) 

C INTERPOLATE  FOR  P ACROSS  INTEGRATION  INTERVAL 

10  DO  15  I - 1 , IMAX 
15  EVI ( I ) - CUVAR ( 2+IMAX+I ) 

MFTL  = 1 

NFTL  « IZTERM  - IPSI  + 1 

CALL  FTLUP  (CUVAR( 1 ), PFTL , MFTL , NFTL , VARI ( IPSI ), P( I PSI ) ) 

C INTERPOLATE  FOR  DPDX 

CALL  FTLUP  (CUVAR( 1 ). DPFTL . MFTL , NFTL , VARI ( IPSI ), DPDX( IPSI ) ) 

IF  (KEYINT . EQ.O)  GO  TO  95 

SUM  = 0.0 

DO  45  I « 1 . IMAX 

C USE  SHOCK  VALUES  FOR  INITIAL  COMPUTATION  ON  EACH  STREAMLINE 

SUM  = SUM  + Cl ( I )/MUI ( I ) 

IF  ( EVI ( I ) . EQ . 0 . 0)  TVI(I)  = 0.0 
IF  ( EVI ( I ) . EQ . 0 . O)  GO  TO  45 

XL  » ((DGENI(I) *R*THETAI ( I ) )/ (MU I (I)*EVI(I))  + 1.0) 

ALN  = DLOG(XL) 

C COMPUTE  TVI 

TVI(I)  « THETAI(I)/ALN 
45  CONTINUE 

MU  = 1 .O/SUM 

U2  = 2 . 0* (HSTAG  - H) 

IF  (U2.LT.O.O)  WRITE ( 15,50)  H 
50  FORMAT( IX, 'U**2  IS  NEG  IN  BASIC  , H = ' , E 1 1 . 4 , 2X , 

* 'END  STREAMLINE  INTEGRATION') 

IF  (U2.LT.0.0)  IUNEG  = 1 
IF  (U2.LT.0.0)  RETURN 
U * DSQRT (U2 ) 

C ITERATE  FOR  E 

KCODE  = 0 
55  KITR1  » 0 
ICODE  * 0 
MAXI  = 50 
TOL 1 ■=  .001 
T0L2  = .00001 
C 

CALL  FOFE  ( MAXI , TOL 1 . T0L2 , ICODE , E ) 

C 

IF  (ICODE. EQ.O)  GO  TO  75 
IF  (ICODE. EQ.1)  WRITE ( 1 5 , 60) 

60  FORMAT (IX, ' * MAXIMUM  ITERATION  EXCEEDED  IN  SUB  BASIC  *:  STOP  66'/) 

IF  (ICODE. EQ. 2)  WRITE(15,65) 

65  FORMAT ( IX , ' ***  DERIVATIVE  = 0 IN  SUB  BASIC  **«*  : STOP  66'/) 

WRITE( 15,70)  ICODE 

70  FORMAT( IX, 'ICODE  = ',12,'  IN  SUB  BASIC  '/) 

IF  ( ICODE. NE.1)  STOP 
IF  (KCODE . EQ . 3 ) STOP 


STOP  66 


C 


C 


c 


c 


c 


c 


WHEN  ICODE  - 1.  TRY  A NEW  STARTING  E.  DO  THIS  2 TIMES  ; 
KCODE  = KCODE  +1 
GO  TO  55 

75  IF  (IEXP.NE. 1)  GO  TO  85 
KCODE  = KCODE  + 1 


IEXP  = O 

IF  (KCODE. EO. 1)  GO  TO  55 
IF  (KCODE . GT . 2)  RETURN 
E « H - H*1 . E-05 
GO  TO  55 

85  RHO  = PFTL/ (H  - E) 

T - (PFTL*MU)/(RHO*R) 

IF  .(T.GT.O.O)  GO  TO  95 

WRITE ( 15, 90)  T.RHO.PFTL.H.E.MU 

90  FORMAT ( IX , ' T NEGATIVE  « ' , E 12 . 4 , IX , ' RHO  « ' . E 1 1 .4 , IX . ' PFTL  « ', 

* Ell. 4./. IX. 'H  * '.Ell. 4. IX. 'E  « ' , E 1 1 . 4 . IX . 'MU  » '.E11.4.2X, 

* 'IN  SUB  BASIC'/) 

E - H - H*1.0E-06 
ITNEG  « 1 

RETURN 

95  KEYINT  « 1 

PI  « 4 . 0*ATAN( 1 .0) 


BC  - 1 . 38054E- 16 
AVGN  « 6 . 02252E+23 

COMPUTE  DCIDX  AND  DEVIDX  FOR  EACH  SPECIE 


I 


DO  210  1=1. IMAX 
DCIDX(I)  = 0.0 
CVSUM1  « 0.0 
CVSUM2  - 0.0 

CORRECTED  RELAXATION  TIME  FOR  PARK  MODEL 
IF  (MODEL. EQ.4 . AND. I . EO. 1 ) THEN 
ND  = RHO*AVGN*CI ( I )/MUI ( I ) 

SIGMAV  = 1 .00£-16*(50000./T)**2 
C = DSQRT(8 . *AVGN*BC*T/ (PI *MUI ( I ) ) ) 

TAUC  = 1 .0/(C*SIGMAV*ND) 

END  IF 

FOR  EACH  REACTION  d 


DO  190  <J  = 1.JMAX 
ICT  = MOD ( J , 2 ) 


II  IS  THE  SELECTED  SPECIE  FOR  REACTION  d 


100 


115 


120 


PHIC 

PHIC 


TO 


1.0 

2.0 


120 

PHI (d ) « 1.0 
PHI (d+1  ) * 1.0 


KNT  = 0 

IF  (ICT.EO. 1)  THEN 
IF  (DIRECT(d) .EO. 1.0) 

IF  (DIRECT(d) .EQ.2.0) 

II  « Md(d) 

IF  (M.EO.O)  GO  TO  115 
IF  ( FI ( 1 1 ) .NE.O.O)  GO 
IF  (PHIC. EO. 1.0) 

IF  (PHIC. EO. 2.0) 

GO  TO  125 

IF  (MODEL. EO. 3. AND. UP(II) .NE.O.O)  GO  TO  122 
TEM  « DEXP ( THETA I (II )/TVI (II)) 

TEM1  = DEXP ( THETA I ( I I ) /T ) 

TEM2  = DEXP(-NI(II)*(THETAI(II )/TVI (II)  - THETAI (II )/T) ) 

TEM3  * DEXP (THETA I ( I I ) /TVI ( I I ) - THETAI ( I I )/T ) 

IF  (TEM3.E0. 1 .0. AND. PHIC. EO. 1 .0)  PHI(d)  * 1.0 
IF  (TEM3 . EO. 1 .0. AND. PHIC. EO. 2.0)  PHI(d+l)  * 1.0 
IF  (TEM3.E0. 1 .0)  GO  TO  125 

PHI  * COUPLING  COEFF.;  FOR  CVD.CVDV  AND  PARK  MODEL 
IF  (PHIC.EO. 1 .0)  PHI(d)  = ((1 .0-TEM2)/(TEM3-1 .0)*(TEM  - 1.0) 

► /(TEM1  - 1.0) )/NI (II) 

IF  (PHIC.EO. 2.0)  PHI ( d+ 1 ) = ( ( 1 ,0-TEM2)/(TEM3-1 .0)*(TEM  - 1.0) 

> / (TEM1  - 1.0) )/NI (II) 


GO  TO  125 

122  USUM  = 0.0 
TSUM  = 0.0 
TFSUM  =0.0 
TVTSUM  =0.0 

TF  • 1 . 0/ ( 1 . /TVI (II)  - 1./T  - 1./UP(II)) 

NIC  = NIP ( 1 1 ) + 1 
DO  123  N = 1 .NIC 
XN  = N 

EEVP  = XN  - 0.5 

EVP(N)  n EEVP* ( WE (II)  + EEVP* ( -WEXE  ( 1 1 ) + EEVP* ( WEYE ( 1 1 ) + 
* WEZE ( 1 1 ) *EEVP  ) ) ) 

EVP(N)  = EVP(N)  - EVP ( 1 ) 

USUM  = USUM  + DEXP ( EVP (N)/UP ( I I ) ) 

TSUM  = TSUM  + DEXP(-EVP(N)/T) 

TFSUM  = TFSUM  + DEXP(-EVP(N)/TF ) 

123  TVTSUM  = TVTSUM  + DEXP ( -EVP( N )/TVI ( 1 1 ) ) 


C COUPLING  COEFF.  FOR  CVDV-PREFERENTI AL  MODEL 

IF  (PHIC.EO. 1 .0)  PHI(J)  « (TSUM«TFSUM)/(USUM*TVTSUM) 

IF  (PHIC.EO. 2.0)  PHKJ+1)  » (TSUM*TFSUM)/(USUM*TVTSUM) 

125  KNT  - KNT  + 1 

IF  (KNT. E0.1. AND. PHIC.EO. 1.0)  THEN 
PHIC  • 2.0 
II  « MJ( J+1 ) 

GO  TO  lOO 
END  IF 

IF  ( KNT. EO. 1 -AND. PHIC.EO. 2.0)  THEN 
PHIC  « 1.0 
II  » MJ(J+1) 

GO  TO  100 
END  IF 

C START  OF  LOOP  TO  DETERMINE  EQUILIBRIUM  CONSTANT 

BETAJ  - 0.0 
FJORT  « 0.0 
DO  130  K * 1, IMAX 
SUMG  - 0.0 
LI I ■ LI (K) 

DO  128  L - 1.LII 

128  SUMG  - SUMG  + GIL( L . K ) *DEXP( -EPSI I L(L , K)/T ) 

C MUIOT  « (CHEMICAL  POTENTIAL)/T 

MUIOT  • - (BI(K)  + (5.  + 2.*FI(K))/2. *(DLOG(TINF ) + 

* DLOG(T/TINF ) ) + FI (K)*DLOG( 1 . /( 1 . - D EXP ( -THETA I (K)/T))) 

* + DLOG( SUMG/ GIL(I.K)))  + DELHI (K)/( R*T ) 

BETAJ  « BETAJ  + (NUPIJ(K.J)  - NUIJ(K.J)) 

130  FJORT  « FJORT  + (NUPIJ(K.J)  - NUI J(K. J) )*MUIOT 

C KPJ  - EOUIL.  CONST.  (IN  TERMS  OF  PARTIAL  PRESSURES) 

KPJ  « DEXP( -FJORT ) 

C KEQ  - EQUILIBRIUM  CONSTANT 

KEO  = KPJ*(9.8688225E-07*R*T)**( -BETAJ) 

c KJ  * RATE  CONSTANT  (FORW:  J = 1,3,.  BACK:  J * 2,4..) 

IF  (DIRECT( J) . EO. 1 .O)  THEN 
KJ( J)  * AJ( J)*T**BJ( J)*DEXP(-EJ(J)/T) 

IF  (J.E0.19)  KJ( J ) = AJ( J)*TE1**BJ( J ) *DEXP( -E J( J )/TE 1 ) 

IF  (J.E0.21)  KJ( J ) = A J (J)*TE1**BJ(J)*DEXP(-EJ(J)/TE1 ) 

IF(TE1 .LT.2.D3)G0  TO  131 

IF(J.EQ. 19)KE0=( 1 . 8D-08 )*(TE1**1 . 5D0) *DEXP( - 1 . 69D5/TE 1 ) 

IF ( J . EO. 21 )KEQ= ( 3 . 59D-09 )*(TE1**1 . 5D0) *DEXP ( - 1 . 575D5/TE 1 ) 

131  KJ( J+ 1 ) = KJ(J)/KEO 
ELSE 

KJ(J+1)  ■=  AJ(J)*T**BJ(J)*DEXP(-EJ(J)/T) 

IF  (J.E0.19)  KJ( J+ 1 ) « AJ(J)*TE1**BJ(J)*DEXP(-EJ(J)/TE1) 

IF  (J.E0.21)  KJ( J+1 ) ' AJ(J)*TE1**BJ( J)*DEXP ( -E J( J )/TE 1 ) 

IF(TE1 . LT . 2 . D3 )G0  TO  132 

IF(J. EO. 19)KEQ=( 1 . 8D-08 )*(TE1**1 . 5D0) *DEXP(-1 . 69D5/TE 1 ) 
IF(J.EQ.21)KEQ*(3. 59D-09 )* ( TE 1 ** 1 . 5D0)*DEXP( - 1 . 575D5/TE 1 ) 

132  KJ( J)  « KJ(J+1)»KE0 
END  IF 
END  IF 

IF  (NUI J( IMAX+ 1 , J) . EO .0)  SJ(J)  = 1.0 
IF  (NUI J( IMAX+ 1 , J ) . EQ . O)  GO  TO  140 
SUM  = 0.0 

DO  135  I SUM  = 1 , IMAX 

135  SUM  « SUM  + AI J( I SUM , J ) *CI ( I SUM) /MU I ( I SUM) 

SJ(J)  * RHO*SUM 

140  PROD  = 1.0 

DO  180  IPROD  = 1 , IMAX 
IF  (NUIJ(IPROD, J) -EO.O)  GO  TO  180 
TEM  = RHO’CI (IPROD )/MUI( IPROD ) 

IF  (TEM. GE. 0.0)  GO  TO  165 

C LET  PROBLEM  COMPUTE  PROD.  WHEN  Cl  NEG  ; DECIDE  IN  MAIN  ABOUT  ACCEPTING  NEG  Cl 
LABW  = MOD(NUI J( IPROD , J ) , 2 ) 

C LABW  = 0 FOR  EVEN  NUIJ,  ABW  = 1 FOR  ODD  NUIJ 

IF  (LABW. EO.O)  PROD  = PROD*( -TEM) **NUIJ( IPROD . J) 

IF  (LABW.E0.1)  PROD  = - 1 . 0*PROD* ( -TEM)**NUI J( I PROD , J ) 

GO  TO  180 

165  PROD  = PROD*TEM*»NUI J( IPROD , J ) 

180  CONTINUE 

IF  (ICT.EQ.1)  PRODF  * PROD 
BETAIJ  = NUPIJ(I.J)  - NUIJ(I.J) 

DCIJDX(J)  = PHI(J)-KJ(J)*SJ(J)*(MUI(I)/(RHO*U))*PROD*BETAIJ 

C DCIDX  = RATE  OF  PRODUCTION  OF  THE  CONCENTRATION  OF  SPECIE  I 

DCIDX(I)  = DCIDX ( I ) + DCIJDX(J) 

IF  (ICT. EO.O. AND. MODEL. GT. 1 ) THEN 

C OIJ  = NET  RATE  OF  PRODUCTION 

OIJ  « DCIJDX(J-I)  + DCIJDX(J) 

DENOM  « KEO* PH I ( J — 1 )“SJ(J-1 ) * PRODF 
IF  (DENOM. EO. 0.0)  GO  TO  190 

*39 


c 


CHI  ■ DEGREE  OF  NON-EQUILIBRIUM 


CHI  - 1.0  - (PHI(U)*SJ(J )* PROD/D ENOM) 

DEN0M1  « Cl ( I )*CHI 
IF  (DEN0M1 .EQ.O.O)  GO  TO  190 
CVSUM1  * CVSUM1  + QIU/DEN0M1 
CVSUM2  * CVSUM2  + QIJ*(1.0  - CHI)/DEN0M1 
END  IF 

190  CONTINUE 
C 

TEM  « DEXP(THETAI ( I )/T) 

TEM1  - ( FI ( I ) *DGENI ( I ) *R*THETAI ( I ) )/MUI ( I ) 

EVIBAR(I)  * TEM1/(TEM  - 1.0) 

IF  (M.NE.O)  GO  TO  195 
VAR( I+IMAX+2 ) « EVIBAR(I) 

DEVIDX ( I ) - 0.0 
GO  TO  210 
195  TAUSUM  » 0.0 

IF  (FI ( I ). EQ.O.O)  GO  TO  210 

C CVD  MODEL 

DO  200  K * 1 . IMAX 
TEM3  - DEXP ( -THETA I ( I )/T ) 

TEM4  « DEXP(SIGIK(K, I )*T**(-1 ./3. )) 

TEM5  » (FI(I)*ALPIK(K,I))/PFTL 

TAUIK  - TEM5* (T**BETAIK(K, I )*TEM4)/( 1 .0  - TEM3 ) 

C MILLIKAN  & WHITE  RELAXATION  DATA 

IF  (MW. EQ. 1 ) THEN 

IF  (I.EQ.1)  TAUIK  « 1 ,9E-05*DEXP(216.45*T**(-1 ./3. ))/PFTL 
IF  (I.EQ.8)  TAUIK  * 3 . 1845E-05*DEXP( 198 . 66*T** ( - 1 . /3 . ) )/PFTL 
END  IF 

TEM6  * Cl (K)*(EVIBAR( I ) - EVI ( I ) ) 

C PARK  MODEL 

IF  (MODEL. EQ.4 . AND . I . EQ. 1 ) THEN 
TAULP  « TAUIK  + TAUC 

PF  = DABS( (T  - TVI ( I ) )/ (TS  - TINF))**(SP  - 1.) 

TAUSUM  = TAUSUM  + (TEM6/(TAULP*U) )*PF 
GO  TO  200 
ENDIF 

TAUSUM  = TAUSUM  + TEM6/(TAUIK*U) 

200  CONTINUE 

IF  (MODEL. EQ.1)  GO  TO  207 
IF  (MODEL. EQ. 3)  GO  TO  202 

C ADDITIONAL  TERMS  FOR  CVDV  & PARK  MODEL 

IF  (I. EQ. 5. OR. I. EQ. 6. OR. I.EQ.8)  GO  TO  207 
TEM7  « DEXP(THETAI(I )/TVI ( I ) - THETAI ( I )/T ) 

TEM75  = DEXP(NI(I)/4.*(THETAI(I)/TVI(I)  - THETAI ( I )/T) ) 

TEM8  * TEM75**4 

CVDVT  - ((THETAI(I)/(TEM7  - 1.)  - NI ( I )*THETAI ( I )/(TEM8  - 1.)) 

* *R/MUI ( I ) - EVI ( I ) )*CVSUM1  - ((0.5*(NI(I)  - 1 . ) *THETAI ( I ) 

* *R/MUI ( I ) ) - EVI ( I ) ) *CVSUM2 
TAUSUM  = TAUSUM  + CVDVT 

GO  TO  207 

C ADDITIONAL  TERMS  FOR  CVDV-PREFERENTI AL  MODEL 

202  IF  (I. EQ. 5. OR. I. EQ. 6. OR. I.EQ.8)  GO  TO  207 
USUM1  = 0.0 
USUM2  ■ 0.0 
TFSUM1  - 0.0 
TFSUM2  = 0.0 
NIC  = NIP(I)  + 1 

TF  = 1 .0/(1 ./TVI(I)  - 1./T  - 1./UP(I)) 

DO  204  N = 1 .NIC 
XN  = N 

EEVP  = XN  - 0.5 

EVP(N)  = EEVP* ( WE ( I ) + EEVP* ( -WEXE ( I ) + EEVP* ( WEYE ( I ) + 

* WEZE ( I ) *EEVP  ) ) ) 

EVP(N)  = EVP(N)  - EVP( 1 ) 

USUM1  * USUM1  + DEXP(EVP(N)/UP(I)) 

USUM2  = USUM2  + EVP(N ) *DEXP ( EVP( N)/UP ( I ) ) 

TFSUM1  = TFSUM1  + DEXP(-EVP(N)/TF ) 

204  TFSUM2  = TFSUM2  + EVP ( N ) *DEXP ( -EVP (N )/TF ) 

GBAR  = (USUM2/USUM1 )*(R/MUI ( I ) ) 

EBAR  = ( TFSUM2/TFSUM1 ) * (R/MUI ( I ) ) 

CVDVPT  = (EBAR  - EVI ( I ) )*CVSUM1  - (GBAR  - EVI ( I ) ) *CVSUM2 
TAUSUM  = TAUSUM  + CVDVPT 

C DEVIDX  = EQUILIBRIUM  VIBRATIONAL  ENERGY 

207  DEVIDX(I)  = TAUSUM 

DER( 1+IMAX+I)  = DEVIDX ( I ) 

210  CONTINUE 


&0 


C 


DHDX  = DPFTL/RHO 
RETURN 


COMPUTE  DHDX 


o o o o o o 


END 


SUBROUTINE  FOFE  (MAXI , TOL 1 . TOL2 . ICODE  , E 1 ) 

CALLED  BY  SUB  BASIC  TO  EVALUATE  E BY  NEWTON  ITERATION  TECHNIQUE 
IMPLICIT  REAL*8(A-H.0-Z) 

COMMON  /A 1 / TE1.TE2.M. IX. IMAX.IPSI, MODEL 
COMMON  /A2/  P ( 500) , DPDX (500),VARI( 500) 

COMMON  /A3/  EVIINF(25) ,THETAI(25) , MU 1(25) , F I ( 25 ) , DELHI ( 25 ) , 

» Cl INF (25),LI(25) 

COMMON  /A4/  R.MUINF. DELTA. LAMSQ . OMEGSQ . OMEGA, MU. T.U.TINF 
COMMON  / A5/  EPSIIL(20,25),GIL(20.25), CID( 200, 50) 

COMMON  /A6/  VAR( 52  ) , CUVAR (52) ,DER(51  ) 

COMMON  /A7/  MJ( 50) , E J( 50) , A J( 50) , BJ( 50) , DI RECT ( 50) 

COMMON  /A8/  TVI(25).DGENI(25).BI(25).NI(25) 

COMMON  /A  10/  NUI J( 26 , 50) , AIU( 25 , 50) . NUPI J( 25 . 50) 

COMMON  /A  15/  PFTL.KITR1 ,NIP(25) ,UP(25) 

COMMON  /A  1 8/  ITNEG , I EXP 
DIMENSION  Cl ( 25 ) 

EQUIVALENCE  ( CUVAR(3 ) , Cl ( 1 ) ) , (CUVAR(2) ,H) 

REAL*8  MUI, LAMSQ. MUINF, MU 

IF  (IEXP.EQ. 1 .OR. ITNEG. EQ. 1 ) RETURN 
KITR1  - KITR1  + 1 
ITER  = 0 
PORHO  * H - El 
T * PORHO-MU/R 
1 ITER  * ITER  + 1 
E *=  0.0 
DE  = 0.0 
DO  35  I ■ 1, IMAX 
IF  (TVI(I) .EQ.O.O)  THEN 
TEM1  « ( 1 . 5*R*T )/MUI ( I ) + ( FI ( I ) *R*T)/MUI ( I ) 

DTEM1  = 1 . 5*R/MUI ( I ) + FI ( I )*R/MUI ( I ) 

GO  TO  15 
ENDIF 

% TEM  = D EXP (THETA I ( I )/TVI (I ) ) 

J TEM1  = ( 1 ,5*R*T)/MUI ( I ) + ( FI ( I ) *R*T )/MUI ( I ) + 

* ( FI ( I ) •R*THETAI ( I ) )/ ( MUI ( I ) * (TEM  - 1.0)) 

DTEM1  = 1 . 5*R/MUI ( I ) + FI ( I )*R/MUI ( I ) + ( R*FI ( I ) -THETAI ( I ) **2 ) 

* / (MUI ( I ) *TVI ( I ) **2 ) * (TEM/ ( TEM  - 1.0)»*2) 

15  SUMG  ' 0.0 

SUMGE  ' 0.0 
DSUMGE  = 0.0 
LI  I « LI ( I ) 

C 

DO  25  L = 1.LII 
TEM3  = - EPSI I L( L , I )/T 
IF  (TEM3.LT.741 .67)  GO  TO  22 
I EXP  = 1 
RETURN 

22  TEM2  = DEXP( TEM3 ) 

SUMG  = SUMG  + GIL(L, I )*TEM2 
SUMGE  = SUMGE  + GI L( L . I ) *EPSI I L( L , I ) »TEM2 
IF  (SUMGE. LT. 1 .OD+34)  GO  TO  25 
I EXP  = 1 
RETURN 

25  DSUMGE  = DSUMGE  + TEM2*GI L( L , I ) *EPSI I L( L , I ) **2 

DEVI  = R/MUI(I)*(((SUMG*DSUMGE/T**2)  - ( SUMGE/T ) **2 ) 

* /SUMG**2) 

DEI  = DTEM1  + DEVI 

El  * TEM1  + R/MUI(I)*( SUMGE /SUMG)  + DELHI ( I )/MUI ( I ) 

DE  * DE  + DEI *CI ( I ) 

E = E + E I *CI ( I ) 

35  CONTINUE 
C 

IF  (E.GT.H)  ITNEG  = 1 
DFT  « - DE 
FT  = El  - E 
IF  (DFT. EQ.O.O)  THEN 
ICODE  = 2 
RETURN 
ENDIF 

TS1  « T - ( FT/DFT ) 

DELT  = DABS ( TS  1 - T) 

T = TS  1 

El  « H - R*T/MU 

Pi 


o o o o o o 


IF  (ITER. GE. MAXI)  THEN 
ICODE  « 1 
RETURN 
ENDIF 

IF  (DELT.GT.TOL1  ) THEN 
ITER1  ■ ITER 
GO  TO  1 
ENDIF 

ITER2  * ITER  1 + 10 

IF  (DELT.LE.T0L2.0R.ITER.GE.ITER2)  RETURN 

GO  TO  1 

END 


SUBROUTINE  F0FTS1  (MAXI , TOL 1 , T0L2 , ICODE , TSG) 

CALLED  BY  MAIN  TO  EVALUATE  TS  BY  NEWTON  ITERATION  TECHNIQUE 


C 


C 


C 


IMPLICIT  REAL*8(A-H,0-Z) 

COMMON  /A  1/  TE1 ,TE2,M, IX, IMAX, IPSI .MODEL 
COMMON  / A2/  P( 500) , DPDX( 500) , VARI ( 500) 

COMMON  /A3/  EVIINF(25),THETAI(25),MUI(25),FI(25),DELHI(25) 
* ,CIINF(25),LI(25) 

COMMON  / A4/  R , MU INF .DELTA , LAMSQ , OMEGSQ , OMEGA , MU , T, U , TINF 
COMMON  /A5/  EPSIIL(20,25) ,GIL(20,25) , CID( 200, 50) 

COMMON  / A6/  VAR ( 52 ) , CUVAR (52) ,DER(51  ) 

REAL*8  MUI .LAMSQ, MUINF, MU 


ITER  = 0 

1 ITER  = ITER  + 1 
ES  - 0.0 
DES  - 0.0 
DO  25  I = 1 , IMAX 
IF  (M.EQ.1)  EVIS  = EVIINF(I) 

IF  (M.EQ. 1)  GO  TO  5 
TEM  - D EXP (THETA I (I )/TSG) 

EVIS  = (R*THETAI(I))/(MUI(I)*(TEM-1.0))*FI(I) 

DEVIS  * (R*FI(I )*THETAI (I )**2)/(MUI(I ) *TSG**2 ) * (TEM/( TEM- 1 ,0)**2) 
5 SUMG  * 0.0 
SUMGE  =0.0 
DSUMGE  ' 0.0 
LI  I = LI ( I ) 


DO  10  L = 1 , LII 

TEM1  = DEXP ( - EPSIIL(L,I)/TSG) 

SUMG  = SUMG  + TEM1 »GI  L( L , I ) 

SUMGE  « SUMGE  + TEM1 *GIL( L , I ) *EPSI I L( L , I ) 

10  DSUMGE  » DSUMGE  + TEM1 »GI L( L . I ) *EPSI I L( L , I ) **2 
EEIS  = ( R/MUI ( I ) ) * ( SUMGE /SUMG ) 

DEEIS  = R/MUI ( I )*( ( (SUMG*DSUMGE/TSG**2)  - ( SUMGE /TSG ) **2 ) 

* /SUMG**2 ) 

EIS  = ( 1 . 5*R*TSG ) /MUI ( I ) + ( FI ( I ) *R*TSG)/MUI ( I ) + EVIS  + EEIS 

* + DELHI ( I )/MUI ( I ) 

DEIS  = 1 . 5»R/MUI ( I ) + FI ( I )»R/MUI ( I ) + DEVIS  + DEEIS 
ES  = ES  + EIS*CI INF( I ) 

DES  = DES  + DE1S*CIINF(I) 

25  CONTINUE 


FAC  = DSQRT ( OMEGSQ  - 2 .0* LAMSQ* (DELTA  - ES)) 

FIN  = (2.0*MUINF*(DELTA  - ES ) *FAC )/( R* ( OMEGA  + FAC)) 

FTS  = TSG  - FIN 

FAC  1 = R* (OMEGA+FAC )*(MUINF*(DELTA-ES)*(2.0/FAC ) *LAMSQ*DES  - 
* 2.0*FAC*MUINF*DES)  - 2 . 0*MUINF* (DELTA-ES ) *R»LAMSQ*DES 

FAC2  = R**2* ( OMEGA  + FAC)**2 
DFTS  =1.0-  FAC1/FAC2 
IF  (DFTS. EQ. 0.0)  THEN 
ICODE  = 2 
RETURN 
ENDIF 

TSG 1 = TSG  - ( FTS/DFTS) 

DELTS  = DABS ( TSG 1 - TSG) 

TSG  = TSG1 

IF  ( ITER. GE .MAXI  ) THEN 
ICODE  = 1 
RETURN 
ENDIF 

IF  (DELTS. GT. T0L1  ) THEN 
ITER  1 = ITER 


o o o 


END  IF 

ITER2  « ITER1  + 10 

IF  (DELTS.LE.T0L2.0R.ITER.GE.ITER2)  RETURN 

GO  TO  1 

END 


SUBROUTINE  CHECK 
C 

C CHECK  CALLED  BY  CALITH  TO  MAKE  DECISION  TO  ACCEPT  ANSWERS 

C 

C IF  ACCEPTABLE  ; SET  ELB  « 0 AND  RETURN 

C IF  NOT  ACCEPTABLE  ; MODIFY  SPEC  AND  Cl  ; SET  ELB  « 1.0  AND  RETURN 

C 

IMPLICIT  REAL«8(A-H,0-Z) 

COMMON  /A  1 / TE1.TE2.M, IX, IMAX, IPSI, MODEL 
COMMDN  / A2/  P ( 500 ) , DPDX ( 500) , VARI ( 500) 

COMMON  /A3/  EVIINF(25),THETAI(25), MU 1(25), FI(25),DELH 1(25), 

* Cl INF ( 25 ) , LI ( 25 ) 

COMMON  / A4/  R.MUINF, DELTA, LAMSO , OMEGSO , OMEGA. MU, T.U.TINF 
COMMON  / A5/  EPSIIL(20.25) ,GIL(20,25) , CID( 200, 50) 

COMMON  / A6/  VAR( 52 ) , CUVAR ( 52 ) ,DER(51 ) 

COMMON  /A  1 3/  SP.TS.DELX.ZSTERM, I ZTERM, NSR , MW 
COMMON  /A  1 7/  ELB , SPEC , CJ, TPREV , HPREV, HCHECK , TCHECK 
COMMON  /A  18/  ITNEG , I EXP 
REAL*8  MUI, MU, MUINF, LAMSO 
EQUIVALENCE  (CUVAR(2),H) 

C 

IF  (IEXP.NE. 1)  GD  TO  1 
GO  TO  15 

C REDUCE  COMPUTING  INTERVAL  TO  TRY  AND  AVOID  EXP  ERROR  STOP 

1 IF  (ITNEG. EO.O)  GO  TO  4 

C E.GT.H  SOMETIMES  LEADS  TO  NEG  T — REDUCE  INTERVAL  TO  TRY  TO  AVOID  INSTABILITY 
GO  TO  15 

4 IMAXP1  « IMAX  + 1 
DO  10  I * 3.IMAXP1 

C CUVAR( 2 ) = H MAY  BE  NEGATIVE 

IF  fCU VAR (I).LT.O.O)  WRITE(15,5)  I , IX, CUVAR( I ) 

\ IF  ( CUVAR (I).LT.O.O)  GO  TO  15 

? 5 FORMAT( IX, 'NEG  Cl  AT  I * ',13, IX, 'IX  » ' , 1 3 , IX , ' CUVAR ( I ) ■ ', 

* E12.5, IX, 'IN  SUB  CHECK'/) 

10  CONTINUE 

IF  (iX.LT.3)  GO  TO  30 

IF  ((IPSI.EQ.(NSR+1)).AND.(IX.LT.(NSR+3)))  GO  TO  30 
IF  (DABS(TPREV  - T )/T . LT . TCHECK ) GO  TO  25 
WRITE ( 15,11) 

11  FORMAT( IX, 'CHECK  ABS ( TPREV-T )/T . GE . TCHECKT  IN  SUB  CHECK'/) 

15  IF  (SPEC.GT. 1 .OE-15)  GO  TO  20 

WRITE( 15, *) 'SPEC  .LT.  1. OE-15  IN  SUB  CHECK  STOP  30' 

STOP 

C STOP  30 

C REDUCE  INTERVAL 

20  SPEC  « SPEC/4.0 
CJ  « SPEC 
ELB  * 1.0 

WRITE ( 15,22)  SPEC, IPSI , IX , T , TPREV , H , HPREV , I EXP , ITNEG 
22  FORMAT( IX, 'REDUCED  SPEC  = ' , E9 .4 , 2X , ' IPSI  * ',I3,2X,'IX  = ',13, 

* 2X,'T  = ' .E9.4.2X, 'TPREV  = ' , E9 . 4 , / , IX , ' H = '.E9.4.3X, 

* 'HPREV  » ' ,E9.4,3X, 'IEXP  = ', 13 , 3X ,' ITNEG  = '.13,'  IN  CHECK'/) 

ITNEG  = 0 

IEXP  * 0 
RETURN 

25  IF  ( DABS ( ( HPREV  - H)/H ). GT . HCHECK)  WRITE(15,27) 

27  FORMAT( IX, 'CHECK  ABS ( (HPREV-H )/H) . GT . HCHECKT  IN  SUB  CHECK'/) 

IF  (DABS( (HPREV  - H)/H ). GT . HCHECK ) GO  TO  15 
C ACCEPTABLE 

30  TPREV  = T 
HPREV  = H 
ELB  = 0.0 
RETURN 
END 
C 

c 

i C 

SUBROUTINE  SHOCKG  (NXPSTM.ITK) 

C 

C SUBROUTINE  SHOCKG  CALLED  BY  MAIN  AND  MUST  BE  SUPPLIED  BY  USER. 

C X,ZS,RS,RC, COST, SINT  FOR  EACH  X FROM  0.0  TO  X AT  ZSTERM  IN  INCREMENTS 
C OF  ( DELX/NSR ) TO  DELX  AND  INCREMENTS  OF  DELX  THEREAFTER. 

633 


oooooooo 


X » DISTANCE  ALONG  SHOCK 

ZS  « DISTANCE  ALONG  SHOCK  AXIS  OF  SYMMETRY 

RS  « RADIUS  OF  SHOCK 

RC  » RADIUS  OF  CURVATURE  OF  SHOCK 

COST  - COS  OF  ANGLE  OF  ATTACK 

SINT  - SIN  OF  ANGLE  OF  ATTACK 

IMPLICIT  REAL*8(A-H,0-Z) 

COMMON  /A9/  EVIS(25) ,XPST( 100) 

COMMON  /A  12/  SINTM( 1500) , CO STM ( 1500) , RSM( 1 500) , RCM( 1 500) , X 1 ( 1 500) 

* , ZSM( 1500) 

COMMON  /A 13/  SP . TS , DELX , ZSTERM , IZTERM , NSR , MW 

DIMENSION  ZDUM(501 ) ,RSDUM(501 ) . RCDUM(501 ) ,XC(501 ) ,C0DUM(501 ) , 

* SIDUM( 501 ) 

C Rs/L  * SORT ( 2*R*Zs/L  - Bs* ( Zs/L ) **2 ) WHERE:  L * 1.0  cm 

ITK  ■ O 
EL  ' 1.0 
R - 230.0 
BS  - -4.0 
DO  5 I » 2,501 

5 ZDUM(I)  - (1-1 )*ZSTERM/500 
ZDUM(1)  - 0.0 
RSDUM( 1 ) - 0.0 
XC(1)  « 0.0 
CODUM(I)  ' 0.0 
SIDUM(I)  ■=  1.0 
RCDUM(I)  - 230.0 
C 

DO  10  I = 2,501 
ZSND  = ZDUM( I )/EL 

RSDUM(I)  = DS0RT(2 . *R*ZSND  - BS*ZSND**2) 

C = 1 . 0/ ( R - BS*ZSND)**2 

Cl  = DSQRT(C*RSDUM( I )**2  + 1.0) 

XC(I)  « RSDUM( I )/2 . *C1  + 1 ./(2.*DS0RT(C))*DL0G(RSDUM(I)*DS0RT(C) 

* + Cl) 

01  » (R  - BS*ZSND )/RSDUM( I ) 

02  * -((R  - BS*ZSND)**2/RSDUM(I )**3)-  BS/RSDUM(I) 

THETA  *=  ATAN(DI) 

SIDUM(I)  = DSIN(THETA) 

CODUM(I)  = DCOS( THETA) 

RCDUM(I)  = (1.0  + D1**2)**1 ,5/DABS(D2) 

C DIME NS IONA LIZED  QUANTITIES 

RCDUM(I)  = EL*RCDUM( I ) 

XC(I)  = EL*XC( I ) 

RSDUM(I)  = EL*RSDUM( I ) 

10  CONTINUE 
C 

WRITE (8 , 25 ) 

25  FORMAT ( 5X , ' X ' , 1 1X , ' ZS ' , 10X . ' RS ' , 10X , ' RC ' , 9X , 'COST' ,8X, 'SINT'/) 

NOX  « 0 
M « 1 
NZS  * 501 

C INTERPOLATE  SHOCK  VALUES  TO  X SHOCK  COORDINATE 

30  NOX  « NOX  + 1 

IF  (NOX.LT. (NSR+2))  X = X + DELX/NSR 
IF  (NOX.EO. 1 ) X = 0.0 
IF  (NOX.GT. (NSR+1))  X « X + DELX 
CALL  FTLUP  (X . ZS , M , NZS , XC , ZDUM ) 

CALL  FTLUP  ( X , RS , M, NZS . XC , RSDUM ) 

CALL  FTLUP  (X , RC . M, NZS , XC , RCDUM) 

CALL  FTLUP  (X , COST , M. NZS , XC . CODUM) 

CALL  FTLUP  (X , SINT , M, NZS , XC , SIDUM) 

WRITE ( 8 , 35 ) X , ZS , RS , RC , COST , SINT , NOX 

35  FORMAT (1X,6(E10.4,2X),I4) 

SINTM(NOX)  = SINT 
COSTM(NOX)  * COST 
RSM(NOX)  « RS 

RCM(NOX)  = RC 
X 1 (NOX ) « X 
ZSM(NOX)  * ZS 
DO  36  IT  * 2.NXPSTM 

IF  (DABS(XPST( IT ) - X ) . GT . 1 . 0E-06 ) GO  TO  36 
ITK  « ITK  + 1 

36  CONTINUE 

IF  (ZS.GE.O.O)  GO  TO  40 
WRITE ( 15,37)  ZS 

37  FORMAT( IX, ' ZS  SHOULD  BE  GREATER  THAN  0.0  : ZS  = '.E10.5, 

* /.IX, 'STOP  13'/) 


STOP 


ooo  ouooo  oooo 


C STOP  13 

40  IF  (ZS.LT.ZSTERM)  GO  TO  30 
IZTERM  - NOX 
RETURN 
END 


SUBROUTINE  CALITH  ( N , Cl MAX , PHMAX ) 

IN  THE  CALITH  VERSION  OF  CALINT,  THE  VARIABLE  IN  VAR(2)  AND 
CUVAR ( 2 ) MAY  BE  + OR  - . VALUES  OF  OTHER  DEPENDENT  VARIABLES 
ARE  EXPECTED  TO  BE  POSITIVE.  10-69 

IMPLICIT  REAL*8(A-H,0-Z) 

COMMON  /A  1 / TE1 , TE2 , M, IX , I MAX , I PSI , MODEL 
COMMON  /A2/  P(500) ,DPDX(500) , VARI (500) 

COMMON  / A3/  EVI3NF(25) , THETA I ( 25 ) , MU I (25)tFX(25), DELHI ( 25 ) t 
‘ CIINF(25) , LI (25) 

COMMON  / A4/  R , MU INF , DELTA , LAMSO , OMEGSO  f OMEGA , MU , T , U , TINF 
COMMON  / A5/  EPS 1 1 L( 20, 25 ) , GI L( 20 , 25 ) , CID( 200, 50) 

COMMON  / A6/  VAR ( 52 ) , CUVAR (52) v DER ( 5 1 ) 

COMMON  /A7/  MJ( 50) . E J( 50) f AU( 50) , BJ( 50) .DIRECT (50) 

COMMON  /AS/  TVI ( 25 ) , DGENI (25) ,BI(25) , NI ( 25 ) 

COMMON  /A  1 0/  NUI 0(26, 50) , AI J( 25 , 50) , NUP I J( 25 , 50) 

COMMON  /All/  SIGIK(25,25) ,ALPIK(25,25) ,BETAIK(25,25) 

COMMON  /A  1 7/  ELB , SPEC , C J , TPREV, HPREV , HCHECK , TCHECK 
COMMON  /A  1 9/  ELE1(51),ELE2(51),NERR 
REALMS  MUI , MU, MUINF, LAMSO 

DIMENSION  FI (51 ) , F2(51 ) , F3 ( 5 1 ) , CAPF 1 ( 5 1 ) . CAPF2( 5 1 ) ,CAPF3(51 ) 
,P1(51)tPH(51)v DELTY (5 1 ) , Y3(51 ) , Y4 ( 5 1 ) „ F4 ( 5 1 ) , Y2 ( 5 1 ) 


IF  CJ  OR  N IS  EQUAL  TO  ZERO  : NERR  * 1 

IF  ELE 1 IS  LESS  THAN  OR  EQUAL  TO  ELE2  : NERR  * 2 

TEST  INPUT 


997 

998 


999 

1000 
C 

1 

2 

3 


4 
C 

5 


6 

65 


25 


C 

66 

C 


FN  “ N 

TEST  = C J*FN 
IF  (TEST)  998,997,998 
NERR  = 1 
RETURN 

DO  999  I « 1 ,N 

IF  ( ( ELE  1(1)  - ELE2( I ) ) . LE . 0.0)  THEN 
NERR  * 2 
RETURN 
ENDIF 
CONTINUE 
IF  (SPEC)  5,1,5 

SECTION  FOR  INITIALIZATION  COMPUTATION  OF  DERIVATIVES 

SPEC  * CJ 
ICONT  « 1 
NI  - N + 1 
DO  3 I * 1 , N 1 
CUVAR ( I ) - VAR ( I ) 

CALL  BASIC 

RETURN  WITH  DERIVATIVES  IN  DER 

DO  4 I = 1 , N 
F1(I)  * DER ( I ) 

RETURN 

COMPUTE  Y2,X2 

CUVAR ( 1 ) = VAR ( 1 ) + CJ/2.0 
DO  6 I = 1 , N 
11*1+1 

Y2 ( I ) « VAR(II)  + CJ/2 . 0*F 1(1) 

IF  (I.EQ.1)  GO  TO  6 
IF  ( Y2( I ) ) 65,6,6 
CUVAR (II)  = Y2 ( I ) 

GO  TO  66 
SPEC  = CJ 
CJ  = CJ/2.0 

IF  (CJ.LE. 1 . OE-25 ) THEN 
WRITE (15, 25 ) CJ 

FORMAT ( IX,  7 MIN . INTEGRATION  STEP  OF  ',E12.4,'  WAS  REACHED  V) 

STOP 
ENDIF 
GO  TO  5 


CALL  BASIC 


CALL  BASIC  TO  EVALUATE  F2 


DO  7 I = 1 ,N 
II  * I + 1 


RETURN 


c 


F2( I ) * DER(I) 


COMPUTE  Y3 


7 

C 

c 


c 


8 

9 

91 

83 


103 

84 

85 


95 


10 

C 


102 


101 
1 1 


C 


Y3 ( I ) - VARfll)  + CJ/2 . O*  F2  ( I ) 

IF  (I.E0.1)  GO  TO  7 
IF  ( Y3 ( I ) ) 65,7,7 
CUVAR(II)  « Y3  ( I ) 

CALL  BASIC  TO  EVALUATE  F3 


CALL  BASIC 


RETURN 


DO  10  I * 1 ,N 
F3 ( I ) * DER(I) 

COMPUTE  P , PH  AND  CAP  F TERMS 

IF  ( Y3 ( I ) - Y2 ( I ) ) 9.8.9 
P1(I)  « 0.0 
GO  TO  91 

PI  ( I ) * “ ( ( F3 ( I ) - F2 ( I ) )/ ( Y3 ( I ) - Y2( I ) ) ) 

PH( I ) « P1(I)*CJ 
IF  (PH(I))  83,83, 103 
PH( I ) * 0.0 
P 1 ( I ) * 0.0 
GO  TO  84 

21  * DABS ( Y3 ( I ) - Y2(I))/(( DABS ( Y3 ( I ) ) + DABS( Y2( I ) ) )/2 . O) 
IF  (21  - 0.5E-04)  83,83,84 
IF  ( PH( I ) - 0.1)  85,85,95 

CAPFI(I)  * 1.0  - PH( I )/2 . 0 + PH(I)**2/6.0  - PH( I ) **3/24 . 0 
CAPF2 ( I ) * 0.5  - PH(I)/6.0  + PH( I ) **2/24 . 0 - PH( I ) **3/ 1 20 . 0 
CAPF3 ( I ) * 1./6.-  PH( I )/24 . + PH( I ) **2/ 120.  - PH( I ) **3/720 . 
GO  TO  10 

CAPFI(I)  = ( DEXP ( -PH( I ) ) - 1.0)/(-  PH(I)) 

CAPF2 ( I ) = (CAPFI(I)  - 1.0)/(-  PH(I)) 

CAPF3 ( I ) = ( CAPF2 ( I ) - 0.5)/(-  PH(I)) 

CONTINUE 


IS  PH  BETWEEN  ELE2  AND  ELE 1 

IF  (ICONT  - 1 ) 101 , 101 , 102 

ICONT  = ICONT  - 1 

SPEC  « CJ 

GO  TO  17 

DO  11  I * 1 , N 

IF  ( DABS ( PH( I ) ) - ELEI(I))  11,11,13 
CONTINUE 
SPEC  = CU 
GO  TO  15 

HALVE  INTERVAL  AND  DOUBLE  PH  RANGE 


13 


94 

955 

96 


C 

15 

16 
C 


165 

C 

17 


175 


18 


C 


DO  96  I = 1 ,N 

ELE 1(1)  = ELE 1 ( I ) *2 . 0 

IF  ( ELE 1 ( I ) - PHMAX ) 94,94,955 

ELE2 ( I ) = ELE2 (I ) *2 . 0 

GO  TO  96 

ELE 1 ( I ) = ELE1(X)/2.0 

CONTINUE 

SPEC  « CJ 

CJ  = CU/2.0 

ICONT  * 3 

GO  TO  5 

RETURN  TO  RECOMPUTE  INTERVAL 

DO  16  I * 1,N 

IF  ( DABS ( PH( I ) ) - ELE2 ( I ) ) 16,17,17 
CONTINUE 

DOUBLE  INTERVAL 

CJ  * 2 . 0*C J 

IF  (CJ  - CIMAX)  17,17, 165 
CJ  = CIMAX 

COMPUTE  Y4,X4 

DO  18  I = 1 , N 
11=1+1 

CUVAR(II)  = VAR (II)  + SPEC*(F3(I)*(2. 0*CAPF2 ( I ) ) + F 1 ( I )* 
(CAPFI(I)  - 2 . 0*CAPF2 ( I ) ) + F2 ( I ) * PH( I ) *CAPF2 ( I ) ) 

IF  (I .EO. 1 ) GO  TO  18 
IF  (CUVAR(II))  175,18,18 
CJ  = SPEC 
CJ  = CJ/2.0 
GO  TO  5 

Y4 ( I ) = CUVAR(II) 

CUVAR ( 1 ) = VAR ( 1 ) + SPEC 

CALL  BASIC  TO  EVALUATE  F4 

CALL  BASIC 


DO  20  I = 1 ,N 
11=1+1 
F4 ( I ) = DER(I) 


C 


RETURN 


oo  o ooooooo  oo  o ooo  oo 


COMPUTE  DELTA  Y 

DELTY(I)  « SPEC*(F1(I) *CAPF 1 ( I ) + ( - 3 . 0* ( F 1 ( I )+P 1 ( I ) *VAR( I 1 ) ) + 2 . 0* 

* (F2(I)+P1(I)»Y2(I))  + 2.0*(F3(I)+P1(I)*Y3(I))  - F4(I)  - P1(I)* 

* Y4(I))*CAPF2(I)  + 4 ,0*( ( F 1 ( I )+P1 ( I )*VAR( 1 1 ) ) - (F2( I )+P1  ( I )* 

* Y2( I ) ) - (F3(I)+P1(I)*Y3(I))  + (F4(I)+P1(I)’Y4(I)))»CAPF3(I)) 

COMPUTE  Y + DELTA  Y 

20  CUVAR(II)  « VAR(II)  + DELTY(I) 

CALL  CHECK  FOR  DECISION  TO  ACCEPT  OR  RECOMPUTE  INTERVAL 

CALL  CHECK 
IF  (ELB)  21,21.23 

UPDATE  Y VALUES 

21  N1  * N + 1 

DO  22  I « 2 , N1 
II  « I - 1 

22  VAR ( I ) « VAR ( I ) + DELTY(II) 

VAR ( 1 ) * VAR( 1 ) + SPEC 

RETURN  TO  COMPUTE  DERIVATIVES  AT  Y + DELTA  Y 

GO  TO  2 

RETURN  TO  RECOMPUTE  INTERVAL 

23  GO  TO  5 
END 


SUBROUTINE  FTLUP  ( X , Y , M, N , VARI , VARD) 

THIS  SUBROUTINE  IS  A MODIFICATION  OF  LIBRARY  INTERPOLATION 
SUBROUTINE  FTLUP  REVISED  7-7-69 

IMPLICIT  REAL’S ( A-H, 0-Z ) 

DIMENSION  VARI (5 ) , VARD ( 5 ),V(3),YY(2)tII( 100) 

INITIALIZE  ALL  INTERVAL  POINTERS  TO  -1.0  FOR  MONOTONICITY  CHECK 
DO  4 J • 1 , 100 

4 11(d)  « -1 
MA  = IABS(M) 

ASSIGN  INTERVAL  POINTER  FOR  GIVEN  VARI  TABLE  ; THE  SAME  POINTER 
WILL  BE  USED  ON  A GIVEN  VARI  TABLE  EVERY  TIME 

LOCF  = VARI ( 1 ) 

LI  = MOD( LOCF , 100)  + 1 

I = 1 1 ( LI ) 

IF  (I.GE.O)  GO  TO  10 
IF  (N.LT.2)  GO  TO  10 
C MONOTONICITY  CHECK 

IF  (VARI ( 2 ) - VARI ( 1 ) ) 1,1,3 

C ERROR  IN  MONOTONICITY 

2 K - LOCF 

WRITE( 15,102)  d.K 

102  FORMAT ( IX, 'TABLE  BELOW  OUT  OF  ORDER  FOR  FTLUP  AT  POSITION  ', 

* 15 . // , IX,  ' X TABLE  IS  STORED  IN  LOCATION ', 15// ) 

DO  103  d - 1.N 

103  WR I T E ( 1 5 , * ) VARI(d) , VARD(d) 

STOP 

C MONOTONIC  DECREASING 

1 DO  5 d • 2,N 

IF  (VARI(d)  - VARI(d-O)  5,2,2 

5 CONTINUE 
GO  TO  10 

C MONOTONIC  INCREASING 

3 DO  6 d * 2.N 

IF  (VARI(d)  - VARI(d-O)  2,2,6 

6 CONTINUE 

C INTERPOLATION 

10  IF  (I.LE.O)  I » 1 

IF  (I.GE.N)  I = N - 1 
IF  (N.LE. 1)  GO  TO  8 
IF  (MA.NE.O)  GO  TO  99 

C ZERO  ORDER 

8 Y ■ VARD(1) 

GO  TO  800 

C LOCATE  I INTERVAL  (X( I ) . LE . X . LT . X( 1 + 1 ) ) 

99  IF  ( ( VARI ( I ) - X ) * ( VARI ( 1+ 1 ) - X))  61,61,40 
C IN  GIVES  DIRECTION  FOR  SEARCH  INTERVALS 

40  SIGN1  = 1.0 

IN  = SIGN( SIGN1 ,(VARI(I+1)  - VARI(I))*(X  - VARI(I))) 

C IF  X OUTSIDE  ENDPOINTS,  EXTRAPOLATE  FROM  END  INTERVAL 

41  IF  ( ( I+IN) . LE .0)  GO  TO  61 
IF  ((I+IN) .GE.N)  GO  TO  61 
I = I + IN 


£,3*? 


o o o o o o 


61 

c 


c 

200 


C 


201 

209 

702 


800 


IF  ((VARI(I)  - X ) » ( VARI ( 1+ 1 ) - X))  61,61,41 
IF  (MA.EQ.2)  GO  TO  200 

FIRST  ORDER 

Y - (VARD(I)*(VARI(I+1)  - X)  - VARD( 1+ 1 ) * ( VARI ( I ) - X))/ 
* ( VARI ( 1 + 1 ) - VARI ( I ) ) 

GO  TO  800 

SECOND  ORDER 


IF  (N.EQ.2)  GO  TO  2 
IF  (I.EQ.(N-I))  GO  TO  209 
IF  (I.EQ.1)  GO  TO  201 


PICK  THIRD  POINT 


SK  * VARI ( 1+1 ) - VARI ( I ) 

IF  ( (SK*(X  - VARI(I-1))).LT.(SK*(VARI(I+2)  - X)))  GO  TO  209 
L - I 
GO  TO  702 
L - I - 1 

V(1)  = VARI(L)  - X 

V(2)  « VARIU+1)  - X 

V(3)  - VARI (L+2)  - X 

Y Y ( 1 ) - ( VARD(  L ) *V(  2 ) - VARD(  L+ 1 ) *V(  1 ) )/(  VARI  ( L+1  ) - VARI  ( L ) ) 

YY ( 2 ) ■ (VARD( L+ 1 )*V(3 )-VARD( L+2) *V(2) )/( VARI ( L+2)-VARI ( L+1 ) ) 

Y - (YY(1)*V(3)  - YY(2)*V( 1 ))/(VARI( L+2)  - VARI(L)) 

1 1 ( LI  ) * I 

RETURN 

END 


SUBROUTINE  F0FT23  (MAXI , T0L1 , T0L2 , ICODE . TSG, 101 , 102 , 103 ) 

CALLED  BY  MAIN  TO  EVALUATE  TS  BY  NEWTON  ITERATION  TECHNIQUE 
IMPLICIT  REAL +8 ( A -H, 0-2 ) 

COMMON  /A1/  TE1.TE2.M, IX, IMAX.IPSI, MODEL 
COMMON  /A2/  P(500),DPDX(500), VARI (500) 

COMMON  /A3/  EVIINF(25) ,THETAI(25) , MU 1(25) ,FI(25) .DELHI ( 25 ) , 

* Cl INF(25) , LI (25) 

COMMON  /A4/  R.MUINF, DELTA, LAMSO.OMEGSO, OMEGA, MU, T.U.TINF 
COMMON  /A5/  EPSIIL(20.25),GIL(20,25) , CID( 200 , 50) 

COMMON  /A6/  VAR( 52 ) , CUVAR( 52),DER(51) 

DIMENSION  SUMGM( 25) ,EISM(25) , DEISM ( 25 ) 

REAL+8  MU I , LAMSO , MU INF , MU 

W = 1 .0 

DO  1 I = 1 , IMAX 

1 CID(IX.I)  = CIINF(I) 

ITER  = 0 

2 ITER  = ITER  + 1 

IF  (ITER.EQ.1)  THEN 
ES  « DELTA 

PS  = DSQRT(OMEGSQ  - 2 . *LAMSQ*(DELTA  - ES)) 

ENDIF 

IF  (101 . EO. 1 ) THEN 
TVIB  = TINF 
ELSE 

TVIB  * TSG 
ENDIF 

IF  (IQ2.EQ.1)  THEN 
TEL  « TINF 
ELSE 

TEL  = TSG 
ENDIF 

ES  = 0.0 

DES  - 0.0 

DO  25  I * 1 , IMAX 

IF  (M. EO. 1 ) EVIS  = EVIINF(I) 

IF  (M.EO. 1)  GO  TO  5 

TEM  = DEXP(THETAI(I )/TVIB ) 

EVIS  * (R*THETAI(I))/(MUI(I)*(TEM  - 1.0))*FI(I) 

DEVIS  = (R*FI( I )*THETAI( I )**2)/(MUI(I ) *TVIB**2) * (TEM/ (TEM- 1 ,0)**2) 
5 IF  (I.EQ.1)  OVN  = 1.0/O.0  - DEXP( -THETAI  ( I )/TVIB ) ) 

IF  (I.E0.2)  OVO  = 1.0/(1.0  - DEXP( -THETAI ( I )/TVIB ) ) 

SUMGM(I)  = 0.0 
SUMGE  =0.0 
DSUMGE  =0.0 
LI I = LI ( I ) 

DO  10  L = 1.LII 

TEM  1 * DEXP(-EPSIIL(L,  I )/TEL)  , -,-0 


SUMGM(I)  • SUMGM(I)  + TEM1 *GI L( L . I ) 

SUMGE  * SUMGE  + TEM1 *GI L ( L , I ) *EPSI I L( L , I ) 

10  DSUMGE  = DSUMGE  + TEM1 *GI L( L , I ) *EPSI IL( L . I ) **2 
QROTN  - TSG/5.8 
OROTO  ■ TSG/4.2 

EEIS  ■ ( R/MUI ( I ) ) * ( SUMGE/SUMGM( I ) ) 

DEEIS  ■ R/MUI(I)*((( SUMGM( I ) *DSUMGE/TEL**2 ) - ( SUMGE/TEL ) **2) 

* /SUMGM(I )**2) 

EISM(I)  - ( 1 . 5*R*TSG )/MUI ( I ) + ( FI ( I ) *R*TSG)/MUI ( I ) + EVIS  + EEIS 

* + DELHI ( I )/MUI ( I ) 

DEISM(I)  = 1 . 5*R/MUI  ( I ) + FI  ( I ) *R/MUI  ( I ) + DEVIS  + DEEIS 
25  CONTINUE 

C BETA  FOR  OXYGEN 

IF  (103. EO. 2)  THEN 
TD  - 59500.0 

FI  « CIINF(2) *MU INF/MU I ( 2 ) 

CIA  « TD/TSG 

CIA  = DEXP ( CIA/2.0) 

C IB  » 8.8568195*0  . - Cl INF ( 1 ) ) *C 1 A* ( 1 . /(TSG**2 . 5 ) ) 

Cl  » C 1 A*2 . 0*MUINF*PS*C 1B*QV0*QR0T0* ( SUMGM( 2 )/( SUMGM(4 ) **2 ) )/R 
BETAO  = ((FI-1.)  + DSORT(( 1 .-FI )**2  + 4 . * ( F 1+C 1 ) ) )/ ( 2 . * ( F 1+C1 ) ) 
BETAN  = 0.0 
END  IF 


C 


30 


C 


C 


35 


BETA  FOR  NITROGEN  AND  OXYGEN 

IF  (103. EO. 3)  THEN 
BETAN  = . 1 
BETAO  = 1.0 
TDN  - 113500.0 
TDO  = 59500.0 

F 1 A = 8.8568195*0.  - Cl  INF  (1  ) ) *DEXP  (TDO/TSG  ) * ( 1 . / ( TSG**2 . 5 ) ) 

F2A  = 12.36681*0.  - Cl  INF  ( 2 ) ) *DEXP  ( TDN/TSG ) * ( 1 . /( TSG**2 . 5 ) ) 

FI  = 2.O*MUINF*PS*F1A*QV0*QR0T0*(SUMGM(2)/(SUMGM(4)**2))/R 
F 2 = 2.0*MUINF*PS*F2A*QVN*QROTN*(SUMGM( 1 )/ ( SUMGM ( 3 ) **2 ) )/R 
A = ((1.  - BETA0**2)  + BETAN* ( 1 . - BETAO ))/( BETA0**2 ) - FI 
B = ((1.  - BETAN**2)  + BETA0*(1.  - BETAN) )/( BETAN**2 ) - F2 
ABO  = (BETAN*BETA0  - 2.*(1.  + BETAN ))/ (BETA0**3 ) 

ABN  - (1.  - BETA0)/(BETA0**2) 

BBO  = (1.  - BETAN)/(BETAN**2) 

BBN  = (BETAN*BETA0‘ - 2.*(1.  + BETAO  ) )/(BETAN**3 ) 

DEN  = ABO*BBN  - BBO*ABN 
DBO  = ( -A*BBN  + B*ABN  )/DEN 
DBN  = ( -B*ABO  + A*BBO )/DEN 
BETAN  = BETAN  + DBN 
BETAO  = BETAO  + DBO 

IF  ((DABS(DBO).GT. .00001). OR. (DABS ( DBN) . GT . .00001))  GO  TO  30 
END  IF 

DISSOCIATING  CONCENTRATIONS  ACROSS  THE  SHOCK 
CID( IX , 2 ) = (1.0  - BETA0)*CIINF(2) 

CID( IX , 4 ) = BETA0*CIINF(2) 

CID(IX.I)  * 0.0  - BET  AN)  *CI  INF  ( 1 ) 

CID( IX , 3 ) * BETAN*CIINF( 1 ) 


DO  35  I * 1, IMAX 

ES  « ES  + EISM(I)*CID(IX,I) 

DES  » DES  + DEISM(I)*CID(IX,I) 

FAC  = DSORT ( OMEGSO  - 2 . O’LAMSO* ( DELTA  - ES)) 

FIN  = ( 2 . 0*MUINF* (DELTA  - ES ) *FAC )/( R* (OMEGA  + FAC)) 

FTS  - TSG  - FIN 

FAC  1 - R*(0MEGA+FAC)*(MUINF*(DELTA-ES)*(2.0/FAC)*LAMSQ*DES  - 
2.0*FAC*MUINF*DES)  - 2 . 0*MUINF* (DELTA-ES ) *R*LAMSO*DES 
FAC2  = R**2* ( OMEGA  + FAC)**2 
DFTS  =1.0-  ( FAC  1/FAC2  ) 

PS  = FAC 

IF  (DFTS. EO. 0.0)  THEN 
ICODE  = 2 
RETURN 
END  IF 

TSG1  = TSG  - W* ( FTS/DFTS ) 

DELTS  = DABS(TSG1  - TSG) 

TSG  = TSG1 

IF  (ITER. GE. MAXI)  THEN 
ICODE  = 1 
RETURN 
ENDIF 

IF  (DELTS. GT. T0L1  ) THEN 
ITER  1 = ITER 
GO  TO  2 
ENDIF 

ITER2  = ITER  1 + 10 

IF  (DELTS. LE.T0L2. OR. ITER. GE.ITER2)  RETURN 


GO  TO  2 
END 
C 



C 

SUBROUTINE  OLRAD  ( 104 . 105. 106 . 108 . 109 . 1010) 

IMPLICIT  REAL*8(A-H,0-Z) 

COMMON  /A1/  TE1.TE2.M. IX. IMAX.IPSI, MODEL 

COMMON  /A3/  EVI INF(25) .THETA I (25 ), MU I (25 ), FI (25) , DELHI (25) , 

* CIINF(25),LI(25) 

COMMON  /A5/  EPSI IL(20, 25 ) ,GIL( 20, 25) , CIO (200, 50) 

COMMON  /A9/  EVIS(25) ,XPST( 10O) 

COMMON  /RAD/  RCON( 100. 10. 40) . RRHO( 100, 40) ,TEMP( 100.40) 

* , TSTAG. Y( 100,40) , NXCON, NPTS( 100) 

COMMON  /RADC/  YBDY( 100) . B( 100. 8 , 40) . OPTL( 100, 8 , 40) 

COMMON  /RADO/  TEMPO( 100.40) ,ALPN( 100,40) ,ALPO( 100,40) 

COMMON  /RADOL/  BETN( 100.40) ,BETO( 100.40) 

REAL*8  KAPPA ( 100, 8 . 40) , KAP( 100, 4 , 40) . KA( 100, 4 , 40) , MUI 
REAL*8  K11.K22.N.NN 
WRITE (8 , 1 ) 

1 FORMAT(///'  OLSTAD  RADIATION  MODEL') 

I F ( 108 . EO .0)  THEN 

I F ( 106 . EO .0)  WRITE( 8 ,2) 

I F ( 106 . EO . 1)  WRITE (8 , 3 ) 

END  IF 

2 FORMAT ( / ' BETA-BETA(Te)' ) 

3 FORMAT ( / ' BETA«BETA(Tt)' ) 

C NUMBER  DENSITIES 

DO  12  K=3, NXCON 
DO  12  d«1,NPTS(K) 

DO  10  11=1, IMAX 
XXX=RRHO(K , U)*6 . 023D+23 
XXX*XXX»RC0N(K, I I , U)/MUI (II) 

10  RCON(K , I I , d)=XXX 
12  CONTINUE 

IF(IQ10.EQ.O)GO  TO  15 
DO  14  K=3, NXCON 
NUP«NPTS(K)-1 
DO  14  U= 1 , NUP 
T«TEMPO(K,d) 

FNA=RCON(K , 3 , d) 

FNI“RC0N(K,9, d) 

FNE=RCON(K, 7 . d) 

FNM=RCON(K, 1 ,d) 

F0A«RC0N(K,4,d) 

FOI=RCON(K, 10. d) 

FOM=RCON(K, 2 , d) 

C ELECTRON  TEMPERATURE  MODEL 

ITRTE-0 
EI=2 . 3322D- 1 1 
E0*2. 1735D-11 
FAV=6 . 023D23 
SA-1 .52D-15 
F 1 =0 
F2*0 
F0*0 

574  ITRTE-ITRTE+1 

I F ( ITRTE . GT . 1 )G0  TO  571 
KK=  1 

569  KK*KK+ 1 

I F (KK . GT . 50)TE 1 =2000 
I F (KK . GT . 5O)G0  TO  14 
TE«1000*KK 

571  SM=0.5355D-19*TE+. 696D- 1 5 
IF(ITRTE.GT. 50) GO  TO  573 
SI  = 1 . 53614D08*(TE**3)/FNE 
SI =DSORT (SI ) 

SI=( (4.38384D-06)/(TE**2))*DL0G(SI) 

FKF=4. 16D13*(TE**(  0. 50D0) )*DEXP( - 1 .20D05/TE) 

FK1=5.49D13*(TE**(  0.50D0) )»DEXP( - 1 . 045D05/TE ) 

FKB=2.3D21*(TE**(-1 . ODOO) ) *DEXP( 4 . 9D4/TE ) 

FK5= 1 . 53D22*(TE** ( - 1 . ODO) )*DEXP( 5 . 3D4/TE ) 

WEA=FKF*FNA-FKB*(FNI/FAV)*FNE 

W2E=FK1 *F0A-FK5* ( FOI/FAV ) *FNE 

SX= ( FNA+FOA ) ♦SA+( FNI+FOI )*SI+( FNM+FOM)/ ( 2 .ODO) *SM 
W 1 =WEA+W2E 

C W2=DER(8)*U*FAV/VAR(9) 

C W 1 =W2 

FE=T- 1 . 23357D- 10/SX/DSORT(TE ) * ( WEA*EI+W2E*E0+W1 *3 . 45D-16*TE)-TE 
IF( ITRTE . GT . 1 )G0  TO  568 

bHb 


o o 


IF((FE/DABS(FE)=FO).LT.O. DOO)GO  TO  567 

FO-FE 

TO-TE 

GO  TO  569 

567  F 1 *FE 
T1«TE 

566  TE«(TO*F1-T1*FO)/(F1-FO) 

IF (DAB$(TE-T 1 ) . LT . 1 . DOO)GO  TO  573 
IF(DABS(TE-TO) . LT . 1 . DOO) GO  TO  573 
GO  TO  574 

568  I F( ( F E/DABS ( FE ) +FO/DABS ( FO) ) . LT . 0 .ODOO)GO  TD  564 
TO-TE 

FO-FE 
GO  TO  566 
564  F1-FE 
T1-TE 
GO  TO  566 
C 573  CONTINUE 

573  IF(TE.GT.T)TE=T 

IF(ITRTE.GT.50)WRITE(6,572) 

572  FORMAT ( ' ' , 'TE  DID  NOT  CONVERGE') 

TEMP(K , U ) -TE 

14  CONTINUE 

15  CONTINUE 

NONEOUI LIBRIUM  RADIATION  CORRECTION 

IF  (IO5.E0.O)  THEN 
DO  122  K-3 , NXCON 
DO  122  d = 1 , NPTS(K ) 

IF (U . EO . NPTS ( K ) ) THEN 
ALPN(K,d)=0. D+00 
BETN(K,d)=0. D+00 
ALP0(K,d)=O. D+00 
BETO ( K , U ) =0 . D+00 
GO  TO  122 
ENDIF 
0 1N=0 . D+0 
Q2N=0. D+0 
Q3N-0.D+0 
DO  112  III«1.LI(3) 

112  01N=Q1N+GIL(III ,3)*DEXP(-EPSIIL(III ,3)/TEMP(K,d) ) 

DO  113  1 1 1 = 1 , LI (9) 

113  Q2N=Q2N+GIL(III , 9 ) *DEXP( -EPSI I L( I I I ,9)/TEMP(K, J) ) 

DO  130  1 1 1 = 1 , LI ( 1 ) 

130  Q3N=Q3N+GIL(III,  1 ) *DEXP( -EPSI IL( 1 1 1 , 1 )/TEMP(K, U) ) 

RH0 1 =RCON(K  , 3 , J ) * 1 . 40 1 D+01  /6 . 023D+23 
RH02=RC0N( K , 9 , U ) * 1 . 40 1 D+01 /6 . 023D+23 
RH03=RC0N(K, 1 . d)*2.802D+01/6.023D+23 
RH04N=RH0 1+RH02+RH03 

QVIBN=1 . D+0/ ( 1 . D+O-DEXP ( -3 . 39D+03/TEMP ( K , J ) ) ) 

OROTN-TEMP (K, d)/5 . 8D+0 
010=0. D+0 
020=0. D+0 
030=0. D+0 
DO  152  III=1,LI(4) 

152  010=010+GIL(III ,4)*EXP(-EPSIIL(III ,4)/TEMP(K, J) ) 

DO  153  III«1.LI(10) 

153  020=020+GI L (III , 10) »DEXP( -EPSI I L( I I I , 10)/TEMP( K , d ) ) 

DO  160  I I I = 1 ,LI(2) 

160  Q30=Q30+GIL(III , 2 ) *DEXP ( -EPSI I L( I I I . 2 )/TEMP(K, d ) ) 

RH0 1 =RCON ( K , 4 , d ) * 1 . 600D+0 1 /6 . 023D+23 
RH02=RC0N(K, 10,d)*1 . 600D+01/6 . 023D+23 
RH03*RC0N(K , 2 , d ) *3 . 200D+01/6 . 023D+23 
RH040=RHD1+RH02+RH03 

QVIBO= 1 . D+0/ ( 1 . D+O-DEXP ( -2 . 27D+03/TEMP (K , d ) ) ) 

OROTO=TEMP(K. d)/4 . 2D+0 

C 1 =RH04N*2 . 4701 D+01 *QVIBN*QR0TN»Q3N*DEXP( 1 . 1 35D+05/TEMP(K , d ) ) 
C1=Cl/(01N**2»TEMP(K,d)**1 .5) 

C2=RH040* 1 . 7725D+01 *0VIB0*0R0T0*030*DEXP( 5 . 950D+04/TEMP(K , d ) ) 
C2=C2/(Q10*»2»TEMP(K.d)»*1 .5) 

BETN(K,d)  = (RC0N(K,3,d)/RC0N(K, 1 , d ) ) *RCON(K . 3 , d ) *C 1 * 1 . 162D-23 

* /RH04N 

ALPN( K , d ) =RCON (K , 9 , d) /RCON( K . 3 , d ) *RCON( K , 7 , d ) *0 1 N/02N* 

* DEXP ( 1 . 69D+05/TEMP (K,d))/(4.826D+15*TEMP(K,d)**1.5) 
BET0(K,d)=(RC0N(K,4,d)/RC0N(K,2,d) ) »RCON( K , 4 . d ) *C2» 1 .328D-23 

* /RH040 

ALPO(K.d) =RCON( K , 10 , d)/RCON(K , 4 . d) *RCON(K . 7 , d ) *0 10/020* 

* DEXP ( 1 . 575D+05/TEMP (K,d))/(4.826D+15*TEMP(K,d)**1 .5) 
122  CONTINUE 

C ABSORPTION  COEFFICIENTS 

DO  20  K=3, NXCON 

Ml 


o o 


DO  20  0* 1 ,NPTS(K ) 

TT*TEMP(K,d)/ 168800.0 
IF ( IQ6 . EO . 1 ) THEN 

TM*TEMPO(K,d)/ 168800.0 
ELSE 
TM-TT 
END  IF 

C IF((IQ6.£Q. 1) .AND. (TEMPO(K.d) .LE.8.D+03))  GO  TO  20 

C IF(TEMP(K,d) .LE.8.D+03)  GO  TO  20 

I F( 108 . EO . 0)  THEN 
O-BETO(K.d) 

N“BETN(K,d) 

ELSE 

0*1 .D+0 
N* 1 . D+0 
END  IF 

KAPPA (K , 4 , d ) *5 . D- 19*0*RC0N(K , 2 , d)+5 . D-2O*N*RC0N( K , 1 .d) 
KAP(K.4,d)*1 .7D-17*RC0N(K.3,d)*DEXP(-.246/TT) 

KA  ( K , 4 . d ) *0 . D+0 

KAPPA(K , 3 . d ) “2 .0“ 18* (N*RCON(K , 1 , d)+0*RC0N(K , 2 , d ) )+KAPPA(K . 4 , d) 

KAP ( K , 3 , d )*2 . 1D-17*RC0N(K.3.d)*DEXP(-. 165/TT )+KAP(K , 4 , d ) 

KA ( K , 3 , d ) *0 . D+0 

KAPPA(K,2,d)*5. ID- 18* ( N*RCON( K , 1 , d)+0*RC0N(K . 2 , d ) )+KAPPA(  K , 3 , d) 
KAP(K,2,d)*KAP(K,3,d) 

KA(K , 2 , d) =5 . ID- 18*RC0N(K , 4 . d) 

KAPPA ( K . 1 . d )*2 . D- 17*0*RC0N(K , 2 , d)+4 . D- 16*N*RC0N( K , 1 ,d) 

C +KAPPA ( K , 2 , d) 

KAP ( K , 1 ,d)*1 . ID- 17*RC0N( K , 3 , d )+KAP( K, 2 , d ) 

KA (K , 1 ,d)*KA(K.2,d) 

I F( 105 . EQ . 0)  THEN 
N*ALPN(K,d) 

0*ALP0(K, d) 

ELSE 
N*1 . D+0 
0*1 .D+0 
ALPN(K , d )*N 
ALPO(K , d) *0 
END  IF 

I F ( 108 . EO . O)  THEN 
NN*BETN(K,d) 

00-BET0(K,d) 

ELSE 

NN* 1 . D+0 
00*1 .D+0 
BETN(K , d ) *NN 
BETO(K, d)*00 
ENDIF 

KAPPA (K ,5,d)*7.7D-17*( NN*RCON( K , 1 , d )+00*RCON(K , 2 . d) ) 

*DEXP( - . 49/TM)+ 

2 . 6D- 1 7* ( RCON(K . 3 , d ) *N+RCON(K , 4 . d ) *0 ) *DEXP ( - . 723/TT ) 
KAPPA(K,6,d)*2.D- 18*RC0N(K , 2 , d ) *00+6 . OD- 18* ( RC0N(K , 3 , d ) *N+ 

C RCON ( K ,4,d)*0)*DEXP(-. 379/TT ) +KAPPA ( K , 5 , d ) 

I F ( RCON(K . 7 , d ) . LE . 1 . D+OO)  THEN 
KAPPA(K , 7 , d ) “KAPPA (K , 6 , d ) 

GO  TO  909 
ENDIF 

KAPPA ( K , 7 , d ) * 1 . 2D03  * ( ( RCON ( K , 3 , d ) *N+RCON ( K , 4 , d ) *0 ) /RCON ( K , 7 . d ) ) * 

C DEXP ( - . 489/TT )+KAPPA ( K , 6 , d ) 

909  KAPPA(K,8,d)=3.2D-17*( RCON(K , 3 , d) *N+RCON( K ,4,d)*0)*DEXP(-.631 /TT ) 
C +KAPPA (K , 5 , d) 

20  CONTINUE 

C PLANCK  FUNCTION 

DO  30  K*3 , NXCON 
DO  30  d*1 .NPTS(K) 

TT*TEMP(K,d)/ 168800.0 
C IF(TEMP(K,d) .LE.8.D+03)  GO  TO  30 

BLACK* ( TT* 168800 . ) **4*5 . 6696D- 1 2/3 . 1415927 
FF* 15 . D+OO/ ( 3 . 1415927**4) 

XI  *1  ./TT 

B1*FF*(DEXP(-X1 )*(6.+6.*X1  + 3 . *X 1 **2+X  1 **3 ) + 

C DEXP (-2. *X1 ) *0 . 5* ( .75+1 .5*X1+1 . 5*X 1 **2+X 1 **3 ) ) 

X 1*0. 935/TT 

B2*FF*(DEXP(-X1 )*(6 .+6. *X1+3 . *X 1 **2+X 1 **3 )+ 

C DEXP(-2.*X1)*0.5*( . 75+1 ,5*X1+1 . 5*X 1 **2+X 1 **3 ) ) 

X 1 *0 . 835/TT 

B3=FF*(DEXP(-X1)*(6.+6.*X1+3 . *X 1 **2+X 1 **3 )+ 

C DEXP l -2. *X1 )*0.5*( .75+1 ,5*X1+1 . 5*X 1 **2+X 1 **3 ) ) 

X 1 *0 . 754/TT 

B4=FF*(DEXP(-X1)*(6.+6.*X1+3.*X1**2+X1**3)+ 

C DEXP (-2 . *X1 )*0.5*( . 75+1 . S*X1+1 . 5*X 1 **2+X 1 **3 ) ) 


X 1 *0 . 473/TT 

B6*FF*(DEXP(-X1  ) * ( 6 . +6 . *X 1+3 . *X 1 **2+X 1 **3 ) + 

C DEXPC-2. *X1 )*0.5*( .75+1 .5*X 1+1 .5*X1 **2+X 1**3)) 

X 1 «0 . 2 13/TT 

B8«FF*CDEXP(-X1  ) * C6 . +6 . *X 1+3 . *X 1 **2+X 1 **3 ) + 

C DEXP(-2.*X1)*0.5*( .75+1 . 5*X 1+1. 5*X 1 **2+X 1 **3 ) ) 

B8-1-B8 

B2-B2-B1 

B3-B3-B2 

B4-B4-B3 

B6-B6-B4 

B5* 1-B8-B6-B4-B3-B2-B1 
B(K  , 1 , J ) *BLACK*B1 
B( K . 2 , J)*BLACK*B2 
B (K , 3 , J)*BLACK*B3 
B(K,4, J)-BLACK*B4 
B(  K , 6 , J ) 'BLACK *B6 

B(K,7,J)*BLACK*2. 4D-2 1 *RC0N(K , 7,J)*B6*DEXP( . 162/TT) 

B(K , 8 , J) “BLACK *B8 
B(K,5, J)-BLACK*B5 
30  CONTINUE 

C TAU'S 

DO  100  K*3 , NXCON 
DO  100  1*1,8 
IFCI.GT.4)  THEN 

OPTL(K , I , 1 )*KAPPA(k, I , 1 )*DABS(Y(K, 1 )-YBDY(K) ) 

ELSE 

OPTL(K, I , 1 )*(KAPPA(K,I , 1 )+KAP(K, I , 1 )+KA(K, I ,1)) 

C *DABS(Y(K, l)-YBDY(K)) 

END  IF 

DO  100  J*2 , NPTS(K ) 

I F ( I . GT . 4 ) THEN 

K1 1*KAPPA(K, I , U)+KAPPA(K , I , U- 1 ) 

ELSE 

K 1 1 *KAPPA( K , I , U)+KAP(K, I , J )+KAPPA ( K . I , J- 1 )+KAP ( K , I , J- 1 ) 
C +KA (K , I , d )+KA (K , I , J- 1 ) 

ENDIF 

0PTL(K , I , J) *OPTL(K , I,J-1)+(5.D-1*(K11) *DABS (Y(K.J-I) 

C -Y(K, J ) ) ) 

100  CONTINUE 

C ORW 

DO  200  K*3, NXCON 
WRITE ( 8 , 102)  XPST(K) 

102  FORMAT (/// , ' AT  X * '.D11.4) 

WQR*0.0 
DO  180  1*1,8 

CALL  FEI(E1I,E2I,E3I,0PTL(K,I, 1)) 

E0LD-E2I 
JIN*  1 

IFCI.GT.4)  THEN 

K1 1*KAPPA(K, I , 1 )*B(K, 1,1) 

ELSE 

IFCI05.E0. 1)  THEN 
ALPN( K , 1 )*1 . D+0 
ALPO(K, 1 )*1 .D+0 
ENDIF 

K1  1*KAPPA(K, I , 1 )*B(K, I , 1 )+KAP(K,I , 1)*B(K,I , 1 ) *ALPN( K , 1 ) + 
C KA(K , I, 1 ) *B( K , I , 1)*ALP0(K,1) 

ENDIF 

SUM=3. 1415927*E0LD*K11*DABS(Y(K, l)-YBDY(K) ) 

IFCI09.E0.O)  WRITE ( 8 , 222 1 ) JIN, I, SUM 
DO  150  J*2 , NPTS ( K ) 

IFCI.GT.4)  THEN 

K11*KAPPA(K,I, J)*B(K, I, J) 

K22-KAPPA(K,I , J-1 )*BCK, I . J-1 ) 

ELSE 

IFCI05.E0.1)  THEN 
ALPNCK, J)=1 .D+0 
ALPOCK, J)*1 .D+0 
ENDIF 

K1 1 -KAPPA (K, I , J)*B(K, I , J)+KAP(K, I , J)*B(K, I . J)*ALPN(K, J)+ 
C KA(K,I, J)*BCK,I. J)*ALPO(K,J) 

K22=KAPPA(K, I , J- 1 )*B(K , I , J- 1 ) + 

C KAP(K, I , J-1)*B(K. I , J-1 )*ALPN(K, J-1 )+ 

C KA(K,I, J-1)*BCK,I. J-1)*ALP0(K, J-1  ) 

ENDIF 

Z-OPTL ( K , I , J ) 

CALL  FEICE1I,E2I.E3I,Z) 

STSUM-3. 14 1 59* ( K 1 1 *E2I+K22*E0LD ) *DABS ( Y(K,J-1)-Y(K,J)) 
IFCI09.EQ.0)  THEN 

4^/3 


ooo  oooo  ooo 


WRITE(8 , 222 1 ) J.I.STSUM 

2221  FORMAT ( IX , ' AT  d «,,I2,'  BAND  ',12.'  OR  "'.011.4) 

END  IF 

145  SUM-SUM+STSUM 
E0LD-E2I 
150  CONTINUE 

WRITE ( 8 , 103 ) I. SUM 

103  FORMAT ( / , ' FOR  BAND  ',12.'  OR  ■ '.Dll. 4,'  WATTS/SO . CM .' ) 

WQR-WOR+SUM 
180  CONTINUE 

WRITE ( 8 , 101 ) WQR 

101  FORMAT ( / ' TOTAL  OR  « '.Dll. 4,'  WATTS/SO . CM .' ) 

200  CONTINUE 
RETURN 
END 


SUBROUTINE  FEI ( E 1 I . E2I , E3I . Z) 

IMPLICIT  REAL*8(A-H,0-Z) 

COMMON  /RADC/  YBDY( 100) , B( 100. 8 , 40) , OPTL( 100 , 8 , 40) 
CALL  EXPI(Z,E1I ,AUX) 

E2I«DEXP(-Z)-Z*E1I 
E3I«(DEXP(-Z)-Z*E2I)/2.0 
E2I “DEXP( -Z*DSORT ( 3 . D+00) ) 

RETURN 

END 


1 


2 

3 


4 

5 

6 
7 


SUBROUTINE  EXPI (X , RES . AUX) 

IMPLICIT  REAL»8(A-H,0-Z) 

COMMON  /RADC/  YBDY( 100) , B( 100, 8 , 40) , OPTL( 100 , 8 , 40) 

IF ( X-  1 . ) 2,1,1 
YY=  1 ./X 

AUX= 1 . -YY*(((YY+3. 377358 ) »YY+2 . 052 156 )*YY+2 . 709479D-01 )/((((YY* 

C 1 . 072553+5 . 7 1 6943 ) »YY+6 . 945239 ) * YY+2 . 593888 ) » YY+2 . 709496D-01 ) 
RES=AUX* YY*DEXP( -X ) 

RETURN 

IF (X+3 . ) 6,6,3 

AUX=( ( ( ( ( ( (7 . 122452D-7+X- 1 . 766345D-6 )»X+2 . 928433D-5 ) *X-2 . 335379D-4 
C)*X+1 . 664 156D-3 ) *X- 1 . 04 1576D-2 ) *X+5 . 555682D-2 )=X-2 . 50000 ID- 1 )*X 
C+9 . 999999D-  1 
RES=-1 . D+30 
IF ( X ) 4,5,4 

RES=X*AUX-DLOG( ABS(X ) ) -5 . 772 157D- 1 
RETURN 

IF (X+9 . ) 8,8,7 

AUX-1 .-((((5. 1 76245D-2*X+3 . 061037 ) *X+3 . 243655D+ 1 ) *X+2 . 244234D+2 ) *X 
C+2 . 486697D+2 )/( ( ( (X+3. 995 161 )*X+3 . 893944D+ 1 ) *X+2 . 2638 1 8D+1 ) *X 


C+1 .807837D+2) 

GO  TO  9 

8 YY-9./X 

AUX= 1 . -YY*( ( (YY+7.659824D-1 ) *YY-7 . 27 101 5D- 1 ) *YY- 1 . 080693 )/( ( ( (YY 
C*2 . 518750+ 1 . 122927D+1 )*YY+5 . 92 1405 ) *YY-8 . 666702 ) *YY-9 . 7242 16 ) 

9 RES=AUX»DEXP(-X)/X 
RETURN 

END 


SUBROUTINE  CARRAD  (104,105,109) 

IMPLICIT  REAL*8(A-H,0-Z) 

COMMON  /A  1/  TE1 ,TE2,M, IX, IMAX, IPSI .MODEL 

COMMON  /A3/  EVI INF ( 25 ) , THETA I (25) ,MUI(25).FI(25),OELHI(25), 

* CIINF (25) , LI (25) 

COMMON  /A5/  EPSIIL(20,25),GIL(20,25), CID( 200, 50) 

COMMON  / A9/  EVIS(25),XPST( 100) 

COMMON  /RAD/  RCON( 100, 10, 40) , RRHO( 100. 40) . TEMP( 100 , 40) 

* , TSTAG , Y ( 100,40) ,NXCON,NPTS( 100) 

COMMON  /RADC/  YBDY ( 100) , B ( 100, 8 , 40) , OPTL ( 100 , 8 , 40) 

COMMON  /RADO/  TEMPO ( 100 , 40) , ALPN( 100 , 40) . ALPO( 100, 40) 
REAL+8  KAPPA( 100,8.40) ,MUI 
WRITE ( 8 , 1) 

1 FORMAT ( III ' CARLSON  RADIATION  MODEL') 

C NUMBER  DENSITIES 

IF((IQ4.EQ.5).0R. (104. EO. 6))  GO  TO  1111 
DO  12  K*3 , NXCON 
DO  12  J= 1 , NPTS (K ) 

DO  10  11  = 1 , IMAX  , 


10  RC0N(K,II ,d)-RRH0(K.d)-G.023D+23»RCDN(K, II,d)/MUI(II ) 

12  CONTINUE 

C NONEOUI LIBRIUM  RADIATION  CORRECTION 

IF  (I05.E0.0)  THEN 
DO  122  K-3.NXC0N 
DO  122  d-I.NPTS(K) 

I F ( J . EO . NPTSCK ) ) THEN 
ALPN(K,d)-0.D+00 
GO  TO  122 
END  IF 

01- 0. D+0 

02- 0. D+0 

03- 0. D+0 

DO  112  III«1,LI(3) 

112  Q1 »Q1+GIL( I 1 1 . 3 ) »DEXP( -EPSI I L ( 1 1 1 , 3 )/TEMP (K , J ) ) 

DO  113  III«1,LI(9) 

113  Q2-Q2+GI L( III,9)»DEXP(-EPSIIL(III. 9 )/TEMP( K , J ) ) 

DO  130  III-1  ,LI( 1 ) 

1 30  03-03+GI L ( I I I . 1 ) *DEXP( -EPSI I L ( I I I . 1 )/TEMP ( K , J ) ) 

RH01 “RCON(K, 3 , d )» 1 . 401 D+0 1/6 . 023D+23 
RH02=RC0N(K.9,d)*1 .401D+01/6 .023D+23 
RH03=RC0N( K . 1 , d ) -2 . 802D+01 /6 . 023D+23 
RH04 -RHO 1 +RH02+RH03 

OVIB-1 . D+0/ ( 1 . D+0-DEXP( -3 . 39D+03/TEMP( K, J ) ) ) 

QROT-TEMP (K , J )/5 . 8D+0 

C 1 -RH04-2 . 4701D+01 -QVIB-QR0T-Q3-DEXP ( 1 . 135D+05/TEMP ( K , J ) ) 
C1-Cl/(Q1«»2»TEMP(K,d)-»1 .5) 

C2-RH04-8 . 909D+OG-Q1 *DEXP( 1 . 69D+05/TEMP(K , J ) ) 

C2-C2/ (Q2»TEMP(K, J )»* 1 .5) 

ALPHA -0.5D+0 
BETA-0. 5D+0 

132  F=BETA*»2*(1. D+0- ALPHA )»»2*C1+B ETA-1 .D+0 

FA--2 . D+0-BETA--2* ( 1 . D+O-ALPHA )-C 1 
FB-2 . D+O-BETA- ( 1 . D+O-ALPHA ) --2-C 1 + 1 .D+0 
G-ALPHA**2*BETA*C2+ALPHA- 1 .D+0 
GA=2.D+0*ALPHA»BETA*C2+1 .D+0 
GB=ALPHA**2*C2 
DENOM-FA-GB-FB-GA 
DA- ( -F-GB+G-FB )/DENOM 
DB- ( -G-FA+F-GA )/DENOM 
ALPHA-ALPHA+DA 
BETA-BETA+DB 

I F ( (DABS (DA ) . GT . 1 . D-05 ) . OR . (DABS ( DB).GT.1.D-5))  GO  TO  132 
ALPH=RCON(K, 9 , J)/( RCON(K , 9 , J )+RCON(K . 3 , J ) ) 

BET=(RC0N(K,9. d)+RC0N(K,3. J) )/( RCON( K , 9 . d )+RCON( K , 3 , d) 

* +2 . D+0*RC0N(K, 1 , U ) ) 

ALPN(K.d)-(ALPH-»2/( 1 . D+O-ALPH) ) » ( ( 1 . D+O-ALPHA )/( ALPHA- »2 ) ) 

» -(BET/BETA) 

122  CONTINUE 
ENDIF 

1111  CONTINUE 

C PLANCK  FUNCTION 

DO  13  K-3.NXC0N 
DO  13  J- 1 , NPTS(K) 

TTT =TEMP(K. J ) 

CALL  PLANCK(B(K, 1,d).B(K.2.d),B(K,3,d).B(K,4,d) . B ( K , 5 , J ) , TTT ) 

13  I F ( 105 . EO . 0)  B(K, 1 ,d)=ALPN(K,d)*B(K, 1 ,d) 

C ABSORPTION  COEFFICIENTS 

DO  20  K-3.NXC0N 
DO  20  d=1 ,NPTS(K) 

DO  20  1=1,5 

KAPPA(K.I.d)=ABSORB(K.d.I) 

IF((I05.EQ.0) .AND. (I .NE. 1 ) ) KAPPA (K. I , J ) -KAPPA ( K , I , d ) 

* -ALPN(K.d) 

20  CONTINUE 

C TAU'S 

DO  100  K-3.NXC0N 
DO  100  1=1,5 

OPTL ( K , I . 1 ) -KAPPA (K, I . 1 )*DABS(Y(K, 1 )- YBDY ( K ) ) 

DO  100  d=2,NPTS(K) 

0PTL(K.I ,d)=OPTL(K, I ,d-1 )+(0.5*(KAPPA(K, I ,d)+KAPPA(K, I ,d-1 ) )» 
C DABS ( Y(K,d-l)-Y(K,d))) 

100  CONTINUE 

C ORW 

DO  200  K-3.NXC0N 
WRITE ( 8 , 102)  XPST(K) 

102  FORMAT (// , ' AT  X = '.Dll. 4) 

WOR-O.O 
DO  180  1=1,5 

CALL  FEI(E1I,E2I,E3I,0PTL(K,I.l)) 


E0LD-E2I 

dIN«1 

SUM-3 . 1415927*B(K, I , 1 )*EOLD*KAPPA(K, I , 1 )*DABS(Y(K, 1 ) -YBDY (K ) ) 
IF ( 109 . EO .0)  WRITE ( B . 222 1 ) JIN, I, SUM 
DO  150  d-2 , NPTS(K ) 

Z*OPTL(K , I , J) 

I F ( Z . EO .0 . D+0)  THEN 
E2I-1 .D+0 
GO  TO  145 
END  IF 

CALL  FEI ( E 1 I , E2I , E3I , Z ) 

STSUM-3 . 14159»(B(K, I , d) *KAPPA(K , I , d ) *E2I+B(K , I , d- 1 ) * 

C KAPPA(K,I,d-1)*E0LD)*DABS(Y(K,d-1)-Y(K,d)) 

I F ( 109 . EO .0)  THEN 
WRITE ( 8 , 222 1 ) d.I.STSUM 

2221  FORMAT ( IX , ' AT  d -',12,'  BAND  '.12,'  OR  -'.D11.4) 

ENDIF 

145  SUM-SUM+STSUM 
E0LD-E2I 
150  CONTINUE 

WRITE ( 8 103)  I ( SUM 

103  FORMAT ( / ' FORBAND  ',12.'  OR  - ',011.4,'  WATTS/SO . CM .' ) 

WOR-WOR+SUM 
180  CONTINUE 

WRITE (8, 101 ) WQR 

101  FORMAT(/'  TOTAL  OR-', Dll. 4,'  WATTS/SO . CM .' ) 

200  CONTINUE 
RETURN 
END 
C 

C — 

C 

SUBROUTINE  PLANCK ( B 1 ,B2,B3,B4,B5,YY) 

IMPLICIT  REAL*8(A-H,0-Z) 

COMMON  /RAD/  RCON( 100, 10 , 40) , RRHO( 100 , 40) , TEMP ( 100, 40) 

* , TSTAG , Y ( 100,40) ,NXCON,NPTS( 100) 

COMMON  /RADC/  YBDY ( 100) , B ( 100, 6 , 40) , OPTL ( 100, 8 , 40) 

T-YY 

I F ( T . LE . 20000 . 0)fiOTO 1027 
1027  I F (T . GE . 8000 . 0) GOT0 1029 
B1-0.0 
B2-0.0 
B3-0.0 
B4-0.0 
B5-0.0 
RETURN 

1029  IF(T.LE. 10000. 0)GOT01030 
IF(T.LE. 1 2000. OJGOTO 1031 
IF(T.LE. 14000.0) GOT0 1032 
IF(T.LE. 16000. O)G0T01033 
I F(T . LE . 18000.0) GOT0 1034 
GOT0 1240 

1030  B1=10.0**(-65 ,26966+15.87146*DL0G10(T) ) 

B2- 10 . 0** ( -54 . 1 1981+13.22561 *DLOG 10( T ) ) 

B3- 10.0* *(-44 .83075+1 1 . 0539 1 *DL0G1O(T ) ) 

B4 -10. 0**(-16. 52511+4. 425444*0 LOG 10(T ) ) 

B5-10.0**(-8. 874156+2. 21 6357*DL0G10(T ) ) 

B 1 *B 1 * 1000 . 00 

B2-B2* 1000 . 00 
B3-B3* 1000.00 
B4-B4* 1000.00 
B5-B5* 1000 . 00 
RETURN 

1031  B1-( 10.0**(-54. 67501  + 13. 22279*DL0G10(T ) ) ) * 1000 . 0 
B2- ( 1 0.0**( -44 .60436+ 10. 84674*DL0G1O(T) ))* 1000.0 
B3=(10.0**(- 36. 9151 8+9. 0750 18*DL0G1O(T)))* 1000 . 0 
B4=( 10.0* *(-15. 3003 1+4 . 1 19244 *DL0G10( T ) ) ) * 1000 . 0 
B5= ( 10.0** (-7 .831680+1 . 955738*DL0G10(T ) ) ) * 1000 . 0 
RETURN 

1032  B1=( 10.0* *(“47. 32488+1 1 . 42093*DL0G10(T ) ) )* 1000.0 
B2=( 10.0** (-37 .87564+9 . 1 972 1 7*DL0G10( T )))* 1000 . 0 
B3= ( 10.0* *(-31 . 30212+7. 69899 1 *DLDG10(T) ))* 1000.0 
B4=( 10.0** (-14. 17392+3.8431 13*DL0G1O(T) ) )* 1000.0 
B5= ( 10.0** (-7. 128949+1 . 783465*DL0G10(T ) ) ) * 1000 . 0 
RETURN 

1033  B 1 = ( 10.0** (-41 .90448+10. 1 1 359*DL0G1O(T ) ) ) * 1000 . 0 
B2= ( 10. 0**( -32 .87 168+7.99031 6*DL0G1O(T) ))* 1000.0 
B3=( 10.0** (-27. 12 177+6. 69O739*DL0G1O(T )))* 1000.0 
B4=( 10.0** (-13. 12000+3. 58892 1 *DL0G1O(T )))* 1000.0 
B5=( 10.0** (-6. 625956+1 . 662 149*DLDG 10( T )))* 1000 . 0 

£>4  W 


on  o o o 


RETURN 

1034  B 1 * ( 10.0* *(-37. 77432+9. 131 181 *DL0G10(T ) ) ) * 1000 . 0 
B2«( 10. 0**( -28. 96032+7. 059955*DL0G10(T) ))* 1000.0 
B3-( 10.0**( -23. 90936+5. 926629*DL0G10(T) ) )* 1000.0 
B4»( 10.0** (-12. 13764+3. 355253*DL0G10(T) ))* 1000.0 
B5«( 10.0** (-6. 259400+ 1 . 574959*DL0G1O(T ) ) )* 1000.0 
RETURN 

1240  B1 *( 10.0** (-34. 4994 1+8. 36 166*DL0G1O( T ) ) )* 1000.0 
B2«( 10.0** (-25. 87330+6. 33544*DL0G1O(T ) ) )* 1000.0 
B3«( 10.0** (-21 .34066+5. 32298*DL0G1O(T) ) )* 1000.0 
B4-( 10. 0**(-1 1 .28150+3. 1 540*DL0G 10(T ) ) ) * 1000 . 0 
B5«( 10.0** (-5.97387+1 . 50786*DL0G 10( T ) ) )* 1000.0 
RETURN 
END 


FUNCTION  ABSORB(K, I . ISTEP) 

IMPLICIT  REAL*8(A-H,0-2) 

COMMON  /RAD/  RCON( 100 . 10. 40) . RRHO( 100, 40) . TEMP( 100, 40) 

* ,TSTAG,Y( 100,40) ,NXCON,NPTS( 100) 

COMMON  /RADC/  YBDY ( 100) . B( 100, 8 , 40) , OPTL( 100 , 8 , 40) 

THIS  PROGRAM  USES  5 WAVELENGTH  STEPS 
THE  NEXT  CARD  MUST  BE  CHANGED  FOR  GRAY  GAS  CASE 
IGRAY-0.0 
T “TEMP (K , I ) 

BLACKS- ( (5.6697D-05)*(T**4))/3. 14159 
YYY-T 

YY-T/ 10000.0 

IF(YYY.LE. 20000. 0)GOTO 1035 

1036  FORMAT ( 1 HO, 5X , ' T TEST  FAILED  IN  ABSORB') 

CONTINUE 

1035  IF(IGRAY.EO. 1 )G0  TO  1037 

GO  TO  ( 1037, 1038, 1039, 1040, 1041 ), ISTEP 

1037  I F ( YYY . LT . 8000 . 0)GO  TO  1042 
I F ( YYY . LE . 10000 . 0) GOT0 1043 
IF(YYY.LE. 12000 . 0)GOT01044 

I F ( YYY . LE . 1 4000. 0)GOTO 1045 
I F ( YYY . LE . 16000.0) GOT0 1046 
I F ( YYY . LE . 18000 . 0)GOTO 1047 
GOT0 1241 

1042  ABSORB-O . 0 
GO  TO  1048 

1043  ABSORB- ( 1 . 006  ID- 1 3 ) * ( 10. 0** ( -2 . 6064*YY ) ) 

GO  TO  1049 

1044  ABSORB- (9 . 6882D- 15 ) * ( 10 . O** ( - 1 . 5953*YY ) ) 

GO  TO  1049 

1045  ABSORB- ( 2 . 0340D- 1 5 ) * ( 10.0**(-1 ,0304*YY)) 

GO  TO  1049 

1046  ABSORB- ( 6.9685D-16)*( 10. 0** ( -0 . 698 1 *YY ) ) 

GO  TO  1049 

1047  ABSORB- (3.31 B8D- 16 ) * ( 10 . 0** ( -0 . 49675* YY ) ) 

GOT0 1049 

1241  ABSORB- ( 2 . 0976D- 1 6 ) * ( 10.0**(-0. 38605*YY ) ) 

1049  FNDEN-RCON( K ,3,1) 

EDEKT- (4. 7O7D-O6)*(RC0N(K, 7, I )**(2. 0/7.0) )/( ((0.861760-04 )*YYY)** 
11.5) 

EDEKT-DEXP(EDEKT) 

ABSORB- (ABSORB*EDEKT)*FNDEN 

1048  ABS0R1 -ABSORB 

I F ( IGRAY . EO . 1 ) GOT0 1038 
RETURN 

1038  IF( YYY. LT. 8000. 0)GOT01050 
I F (YYY . LE . 10000. 0)G0T01051 
IF( YYY . LE . 1 2000. O)60T0 1052 
I F ( YYY . LE . 14000.0) GOT0 1053 
I F ( YYY . LE . 16000.0) GOT0 1054 
I F ( YYY . LE . 18000. 0)GOT01055 
GOT0 1 242 

1050  ABSORB-O. 0 
GOT0 1056 

1051  ABSORB- ( 5. 9872D-22)*( 10 . 0* * ( 2 . 01935*YY ) ) 

GOT0 1057 

1052  ABSORB- ( 3. 2660D-21 )*( 10 . 0** ( 1 . 28255*YY ) ) 

GOT0 1057 

1053  ABSORB- ( 1 . 1 2430-20) *( 10 . 0** (0 . 835 1 5*YY ) ) 

GOTO  1057 

1054  ABSORB- ( 2 . 1562D-20)*( 10 . 0** ( 0 . 633 1 5*YY ) ) 

GOTO  1057 

1055  ABSORB- ( 3 . 701 2D- 20) *( 10 . 0** (0 . 4865* YY ) ) 


GOTO 1057 

1242  ABSORB* (5 . 4757D-20)*( 10 .0**(0. 3924* YY)) 

1057  FNDEN*RCON(K, 3 , I ) 

EDEKT»(4 . 707D-06 )* (RCON(K, 7 , I )»* (2 . 0/7 . 0) )/( ( (0 . 86 1 76D-04 ) * YYY ) ** 
11.5) 

EDEKT  *DEXP( EDEKT ) 

ABSORB* ( ABSORB* EDEKT ) *FNDEN 
1056  ABS0R2* ABSORB 

IF(IGRAY.EQ. DG0T01039 
RETURN 

1039  I F ( YYY. LT. 8000. 0)GOT01058 
IF( YYY . LE . 10000.0) GOTO 1059 
IF ( YYY . LE . 12000.0) GOTO 1060 
I F( YYY . LE . 14000. 0)GOT01061 
IF( YYY . LE . 16000.0) GOTO 1062 
IF( YYY . LE . 18000.0) GOTO 1063 
G0T01243 

1058  ABSORB-O.O 
GOTO 1064 

1059  ABSORB* ( (7 . 266D-20)* ( 10.0**(21.267*YY)))*(1. 0D-20) 

GOTO 1065 

1060  ABSORB- (2 . 2772D- 19)* ( 10.0** (0 . 77045* YY ) ) 

GOTO 1065 

1061  ABSORB* (4. 847  ID- 19 )*( 10.0** (0.49705* YY) ) 

GOTO 1065 

1062  ABSORB- (8. 1764D- 19 )*( 10. 0** (0 . 33485* YY ) ) 

GOT0 1065 

1063  ABSORB- ( 1 . 19020- 18 )*( 10.0** (0 . 23295* YY) ) 

GOTO 1065 

1243  ABSORB* ( 2 . 19875D- 18 )* ( 10.0** (0. 08485* YY ) ) 

1065  FNDEN=RCON(K ,3,1) 

ABSORB* ABSORB *FNDEN 

1064  ABS0R3* ABSORB 

I F ( I GRAY . EO . 1 ) GOTO 1040 
RETURN 

1040  IF (YYY . LT . 8000. O) GOTO 1066 
IF( YYY . LE . 10000.0) GOTO 1067 
IF( YYY . LE . 12000.0) GOTO 1068 
IF( YYY . LE . 14000.0) GOTO 1069 
I F( YYY . LE . 16000. O) GOTO 1070 
IF( YYY. LE. 18000. 0)G0T01071 
GOTO 1244 

1066  ABSORB-O.O 
GOTO 1072 

1067  ABSORB- (3. 40650-30) *( 10. 0**( 7. 2773*YY)) 

GOTO 1073 

1068  ABSORB* (8 . 3188D-28 )* ( 10.0**(4.8895*YY)) 

GOTO 1073 

1069  ABSORB* (2 . 86430-26)* ( 10 .0** ( 3 . 6087* YY ) ) 

GOTO 1073 

1070  ABSORB* ( 1 . 99280-25)* ( 10.0** ( 3 . 00695* YY ) ) 

GOTO 1073 

1071  ABSORB* ( 3. 93760-24 )*( 10.0**(2. 1971*YY) ) 

GOTO 1073 

1244  ABSORB* (4 .2515D-24)*( 10.0**(2. 1786*YY)) 

1073  FNDEN=RCON(K , 3,1) 

EDEKT* (4 . 7070-06 ) *( RCON(K, 7 , I ) ** ( 2 . 0/7 . O) )/( ( (0 . 86 1 76D-04 ) *YYY ) ** 
11.5) 

EDEKT=DEXP( EDEKT) 

ABSORB=(ABSORB*EDEKT)*FNDEN 

1072  ABS0R4* ABSORB 

IF( IGRAY . EO . 1 )GOTO 104 1 
RETURN 

1041  IF ( YYY . LT . 8000 .0)G0T0 1074 
IF( YYY . LE . 10000. 0) GOTO 1075 
IF( YYY . LE . 12000.0) GOTO 1076 
IF( YYY. LE. 14000. 0)GOT01077 
I F( YYY . LE . 16000.0) GOTO 1078 
IF( YYY . LE . 18000 .0)GOTO 1079 
GOTO 1245 

1074  ABSORB-O.O 
GOTO 1080 

1075  ABSORB* ( 3 . 1595D-27 ) * ( 10 . O** ( 6 . 54335* YY  ) ) 

GOTO 1081 

1076  ABS0RB=(6.8837D-25)*( 10.0** (4.205 15*YY) ) 

GOTO 1081 

1077  ABSORB* ( 1 . 8079D-23 )*( 10 . 0** ( 3 . 02235*YY ) ) 

GOT0 1081 

1078  ABSORB* (4. 1675D-22)*( 10 . 0**( 2 . 04900*YY ) ) 

GOT0 1081 
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1079  ABSORB- ( 2. 4630D-2 1 )*( 10.0**( 1 ,56667-YY) ) 

GOT0 1081 

1245  ABSORB- ( 1 .0535D-20)*( 10.0**( 1 ,2161*YY) ) 

1081  FNDEN«RCON( K ,3,1) 

ABSORB- ABSORB *FNDEN 

1080  ABS0R5-ABS0RB 

I F ( IGRAY . EO . 1 ) GOTO 1082 
RETURN 

1082  ABSORB* (ABS0R1*B(K, 1 . I )+ABS0R2*B ( K , 2 , I )+ABS0R3*B(K , 3 , I ) + 
1 ABS0R4-B ( K , 4 , I )+ABS0R5*B(K, 5 , I ) )/BLACKB 

ABSORB-ABSORB* ( 1 . 0D+07 ) 

RETURN 

END 


SUBROUTINE  CORRAD  (104,105.106,108,109) 

IMPLICIT  REAL«8(A-H,0-Z) 

COMMON  /A  1 / TE1 .TE2.M. IX, IMAX, IPSI .MODEL 

COMMON  /A3/  EVIINF(25) , THETA I ( 25 ) , MU I (25),FI(25),DELHI(25), 

* CIINF(25),LI(25) 

COMMON  /A5/  EPSIIL(20,25) ,GIL( 20 , 25 ) , CID( 200 , 50) 

COMMON  / A9/  EVIS(25) ,XPST( 100) 

COMMON  /RAD/  RCON( 100 . 10, 40) , RRHO( 100, 40) , TEMP( 100, 40) 

* , TSTAG , Y ( 100,40) ,NXCON,NPTS( 100) 

COMMON  /RADC/  YBDY ( 100 ) , B ( 100 . 8 , 40 ) , OPTL ( 100 , 8 . 40 ) 

COMMON  /RADO/  TEMPO( 100, 40) , ALPN( 100, 40) . ALPO( 100, 40) 

COMMON  /RADOL/  BETN( 100 , 40 ) . BETO ( 100 , 40 ) 

DIMENSION  CR ( 40 , 13) 

REAL*8  KAPPA( 100,8,40) ,MUI 
WRITE ( 8 , 1 ) 

1 FORMAT ( /// ' CORNELL  RADIATION  MODEL') 

IF(IQ8.EQ.O)  THEN 

IF(I06.E0.0)  WR I TE ( 8 , 2 ) 

I F ( 106 . EO . 1 ) WRITE(8.3) 

END  IF 

2 FORMAT ( / ' BETA-BETA(Te) ' ) 

3 FORMAT (/ ' BETA-BETA(Tt)'  ) 

NUMBER  DENSITIES 
AND  NONEOUI LIBRIUM  CORRECTION 
I F( ( 104 . EO . 5 ) . OR . ( 104 . EQ . 6 ) ) GO  TO  1111 
DO  10  K-3.NXC0N 
DO  10  J-1 ,NPTS(K) 

DO  10  II-1 , IMAX 
XXX=RRHO(K , <J  ) *6  . 023D+23 
XXX=XXX*RCON(K, II , J)/MUI(II) 

10  RCON(K, II ,U)=XXX 
IF  (I05.E0.0)  THEN 
DO  122  K-3.NXC0N 
DO  122  J= 1 , NPTS ( K ) 

IF(J.EQ.NPTS(K))  THEN 
ALPN( K , J ) =0 . D+00 
BETN(K , 0 ) =0 . D+00 
GO  TO  122 
ENDIF 
01=0. D+0 
02-O.D+O 
03=0. D+0 

DO  112  111=1, LI(3) 

112  Q1-01+GIL(III,3)=DEXP(-EPSIIL(III,3)/TEMP(K,vJ)) 

DO  113  III=1,LI(9) 

113  02=02+GIL(III ,9)*DEXP(-EPSIIL(III ,9)/TEMP(K, J) ) 

DO  130  111=1, LI (1) 

130  03=03+GI L (III,  1 )*DEXP(-EPSIIL(III , 1 )/TEMP( K , J ) ) 

RH0 1 -RCON ( K , 3 , J ) * 1 . 401 D+01/6 . 023D+23 
RH02  = RC0N( K , 9 , J ) * 1 . 40 1 D+0 1 /6 . 023D+23 
RH03=RC0N(K, 1 , J ) -2 . 802D+01/6 . 023D+23 
RH04 -RHO 1 +RH02+RH03 

OVIB-1 . D+0/ ( 1 . D+0-DEXP( -3 . 39D+03/TEMP(  K , J ) ) ) 

OROT =TEMP(K,U)/5. 8D+0 

C 1 =RH04*2 . 4 701 D+0 1 *QVIB*0R0T*Q3*DEXP  ( 1 . 1 35D+05/TEMP  ( K , J ) ) 

C 1-C 1/(01 **2*TEMP(K, J)**1 .5) 

C2=RH04*8. 909D+06»0 1 *DEXP ( 1 . 69D+05/TEMP ( K , U ) ) 
C2=C2/(Q2*TEMP(K, J)**1 .5) 

ALPHA-0. 5D+0 
BETA-0. 5D+0 

132  F-BETA*  *2* ( 1 . D+0- ALPHA )**2*C1+B ETA-1 .D+0 
FA--2 . D+0*BETA  **2* ( 1 . D+O-ALPHA ) *C 1 
FB-2 . D+0* BET A* ( 1 . D+O-ALPHA ) **2»C 1 + 1 .D+0 
G= ALPHA* *2*BET A*C2+ALPHA- 1 .D+0 


GA«2.D+0*ALPHA*BETA*C2+1 .D+0 

GB«ALPHA**2*C2 

DENOM-FA*GB-FB*GA 

DA=(-F*GB+G*FB)/DENOM 

DB«  ( -G*FA+F*GA )/DENOM 

ALPHA-ALPHA+DA 

BETA-BETA+DB 

I F ( ( DABS ( DA ) . GT . 1 . D-05 ) . OR . ( DABS( DB ) . GT . 1 . D-5 ) ) GO  TO  132 
ALPH=RCON(K , 9 , J )/( RCON(K , 9 , U )+RCON(K, 3,0)) 

BET« ( RCON(K , 9 , J )+RCON(K , 3 . 0) )/( 2 . D+0*RCON(K , 1 , J ) + 

* RCON( K , 9 , J )+RCON(K , 3 , J) ) 

IF(IOG.EO. 1)  GO  TO  188B 

BETN(K,d)«(BET**2/( 1 . D+O-BET ))*(( 1 . D+O-BETA )/(BETA*»2 ) ) 

* *( ( 1 ,D+0-ALPH)»»2/( 1 .D+0-ALPHA)»*2) 

1888  ALPN(K, J) -BET* ( ALPH«*2/( 1 .D+O-ALPH)) 

* *(( 1 .D+0-ALPHA)/(BETA*ALPHA*»2) ) 

122  CONTINUE 

DO  142  K = 3 , NXCON 
DO  142  J=1,NPTS(K) 

I F ( J . EO • NPTS( K) ) THEN 
ALPO(K, J)*0.D+00 
BETO(K,U)=O.D+O0 
GO  TO  142 
ENDIF 
01-0. D+0 
02=0. D+0 
03=0. D+0 

DO  152  111=1, LI(4) 

152  01=01 +GIL(III,4)*EXP (-EPS IIL(III , 4 )/TEMP(K , J ) ) 

DO  153  I I I = 1 ,LI( 10) 

153  Q2*Q2+GI L (III,  10) *DEXP ( -EPSI I L(  III,  10)/TEMP(K,  U) ) 

DO  160  111  = 1, LI(2) 

160  03“03+GIL( III,2)*DEXP(-EPSIIL(III, 2 )/TEMP(K, J) ) 

RHO 1 =RCON( K , 4 , U ) » 1 . 600D+01 /6 . 023D+23 
RH02«RCDN(K , 10, J)*1 . 600D+01/6 . 023D+23 
RH03=RC0N( K , 2 , 0) *3 . 200D+01/6 . 023D+23 
RH04«RH01+RH02+RH03 

QVIB-1 . D+0/ ( 1 . D+0-DEXP( -2 . 27D+03/TEMP(K, J) ) ) 
QR0T«TEMP(K,d)/4.2D+O 

C 1 *RH04* 1 . 7725D+01 *QVIB*0R0T»Q3*DEXP ( 5 . 950D+04/TEMP(  K , U ) ) 
C1=C1/(Q1»»2*TEMP(K, J)**1 .5) 

C2=RH04*7 . 801D+06+01 *DEXP( 1 . 58D+05/TEMP ( K , J ) ) 
C2*C2/(02*TEMP(K,U)**1 .5) 

ALPHA-0. 5D+0 
BETA-0. 5D+0 

162  F=BETA**2»( 1 . D+0- ALPHA )*»2*C1+B ETA-1 .D+0 

FA«-2.D+0*BETA*»2»( 1 . D+O-ALPHA ) *C 1 
FB=2.D+0*BETA*( 1 . D+O-ALPHA ) **2*C1+ 1 .D+0 
G«ALPHA»*2»BETA»C2+ALPHA- 1 .D+0 
GA=2 . D+0*ALPHA*BETA*C2+ 1 .D+0 
GB=ALPHA»*2*C2 
DENOM=FA*GB-FB*GA 
DA» ( -F»GB+G*FB )/DENOM 
DB« ( -G*FA+F*GA  )/DENOM 
ALPHA-ALPHA+DA 
BETA-BETA+DB 

I F ( (DABS(DA) .GT. 1 .D-05) .OR. (DABS(DB) . GT . 1 .D-5))  GO  TO  162 
ALPH=RCON(K, 10, J )/ ( RCON(K . 10, J )+RCON(K , 4 , J ) ) 

BET*(RCON(K, 10, J )+RCON(K , 4 , J) )/( 2 . D+0*RC0N(K, 2, J)+ 

* RCON(K, 10, J)+RC0N(K,4,U) ) 

I F (106 . EO . 1)  GO  TO  1999 

BETO(K, J)  = (BET**2/( 1 . D+O-BET ))*(( 1 . D+O-BETA )/(BETA**2 ) ) 

* *( ( 1 . D+O-ALPH ) *»2/( 1 . D+O-ALPHA ) * ^ 2 ) 

1999  ALP0(K,j)=BET*(ALPH**2/( 1 .D+O-ALPH)) 

* *( ( 1 .D+O-ALPHA )/(BETA*ALPHA»*2 ) ) 

142  CONTINUE 

C BETA-BETA (Tt ) 

IF(IQ6.EQ.  1)  THEN 
DO  1122  K=3, NXCON 
DO  1122  U=1 ,NPTS(K) 

IF(U.EO.NPTS(K))  THEN 
BETN(K,J)=0. D+00 
GO  TO  1122 
ENDIF 
01=0. D+0 
02=0. D+0 
03=0. D+0 

DO  1112  III-1 ,LI(3) 

1112  01=01+GIL(III ,3)*DEXP(-EPSIIL(III . 3 )/TEMPO( K , U ) ) 

DO  1113  1 1 1 = 1 , LI (9) 


1113 


Q2»Q2+GIL( III ,9)*DEXP(-EPSIIL(III , 9 )/TEMPO(K . d ) ) 

DO  1130  III-1  , LI ( 1 ) 

1 130  Q3»Q3+GIL( III , 1 )*DEXP(-EPSIIL( III  , 1 ) /TEMPO (K , U ) ) 

RH0 1 «RCON( K , 3 , J ) * 1 . 40 1 D+01 /6 . 023D+23 
RH02«RC0N( K . 9 , U ) * 1 . 40 1 D+01 /6 . 023D+23 
RH03-RC0N(K, 1 , J ) *2 . 802D+01 /G . 023D+23 
RH04-RH0 1+RH02+RH03 

QVIB- 1 . D+0/ ( 1 . D+O-DEXP ( -3 . 39D+03/TEMP0( K , 0 ) ) ) 

QROT-TEMPO(K, J)/5.8D+0 

C 1 =RH04*2 . 4 701 D+01  *QVIB*QR0T*Q3*DEXP( 1 . 1 35D+O5/TEMP0 ( K , J ) ) 
Cl -C 1/(01 **2*TEMP0(K,U)**1 .5) 

C2-RH04*8 . 909D+06*Q1*DEXP( 1 . 69D+O5/TEMP0( K , J ) ) 

C2-C2/ ( 02 "TEMPO ( K , 0 ) * * 1 .5) 

ALPHA-0. 5D+0 
BETA-0. 5D+0 

1 132  F»BETA**2*( 1 . D+0- ALPHA )**2*C1+B ETA-1 .D+0 

FA--2 .D+0*BETA**2*( 1 . D+O-ALPHA ) *C 1 
FB-2 . D+0* BET A* ( 1 . D+O-ALPHA )* *2 *C 1 + 1 .D+0 
G=ALPHA**2*BETA*C2+ALPHA- 1 .D+0 
GA-2 .D+0*ALPHA*BETA*C2+1 .D+0 
GB -ALPHA **2*C2 
DENOM-FA-GB-FB-GA 
DA- ( -F*GB+G*FB )/DENOM 
DB=(-G*FA+F*GA)/DENOM 
ALPHA-ALPHA+DA 
BETA-BETA+DB 

IF( (DABS(DA) .GT. 1 . D-05 ) .OR. (DABS(DB) .GT. 1 -D-5) ) GO  TO  1132 
BET- ( RCON(K , 9 . J )+RC0N(K , 3 , U ) )/( 2 . D+0*RCON(K , 1 , J)+ 

* RCON( K , 9 , J )+RCON( K , 3 , d ) ) 

ALPH-RCON( K ,9,U)/(RC0N(K,9, 0 )+RCON( K , 3 , J ) ) 
BETN(K,J)=(BET**2/( 1 .D+O-BET) )*( ( 1 . D+O-BETA )/ ( BETA* *2 ) ) 

* *( ( 1 . D+0- A L PH ) **2/( 1 . D+O-ALPHA ) **2 ) 

1122  CONTINUE 

DO  1142  K=3,NXC0N 
DO  1 142  J=1 , NPTS ( K ) 

I F ( J. EO.NPTS(K) ) THEN 
BET0(K,J)=0. D+00 
GO  TO  1142 
ENDIF 

01- 0. D+0 

02- 0. D+0 
03=0. D+0 

DO  1152  111=1, LI (4) 

1 152  Q1=Q1+GIL(III ,4)-EXP(-EPSIIL(III , 4 )/TEMP0 (K , U ) ) 

DO  1153  III-I.LI(IO) 

1 153  02-02+GI L (III, 10) -DEXP ( -EPSI I L( 1 1 1 , 10) /TEMPO ( K , J ) ) 

DO  11G0  III-1  , LI ( 2 ) 

1 160  Q3  = 03+GIL(III , 2 ) -DEXP ( -EPSI I L ( 1 1 1 ,2)/TEMP0(K,  J) ) 

RH0 1 =RCON( K , 4 , J ) * 1 . 600D+01/6 . 023D+23 
RH02*RC0N( K , 10, J)*1 . 600D+01 /6 . 023D+23 
RH03=RC0N( K , 2 , J ) *3 . 200D+01/ 6 . 023D+23 
RH04-RH01+RH02+RH03 

OVIB-1 . D+0/ ( 1 . D+O-DEXP ( -2 . 27D+03/TEMP0 (K , J ) ) ) 

OROT  «TEMPO( K , U )/4 . 2D+0 

C1-RH04-1 . 7725D+01 -OVIB -OROT -03 -DEXP ( 5 . 950D+04/TEMPO ( K , U ) ) 
C1-C 1/(01 *»2*TEMP0(K,d)»*1 .5) 

C2-RH04-7. 801D+06-01 *DEXP( 1 . 58D+05/TEMPO ( K , J ) ) 

C2-C2/ ( 02*TEMP0 ( K , d ) ** 1 .5) 

ALPHA-0. 5D+0 
BETA-0. 5D+0 

1 162  F-BETA--2* ( 1 . D+O-ALPHA )» *2*C 1+BETA- 1 .D+0 
FA--2 . D+O-BETA * -2 * ( 1 . D+O-ALPHA ) *C 1 
FB-2. D+O-BETA* ( 1 . D+O-ALPHA ) **2*C 1+ 1 . D+0 
G=ALPHA**2*BETA*C2+ALPHA- 1 .D+0 
GA-2 . D+0*ALPHA*BETA*C2+ 1 .D+0 
GB* ALPHA- *2*02 
DENOM»FA*GB-FB*GA 
DA* ( -F*GB+G*FB )/DENOM 
DB=(-G*FA+F*GA )/DENOM 
ALPHA-ALPHA+DA 
BETA-BETA+DB 

IF( (DABS(DA) .GT. 1 .D-05) .OR. (DABS(DB) .GT. 1 .D-5) ) GO  TO  1162 
BET  * ( RCON( K , 10, J )+RCON( K , 4 , J ) )/ ( 2 . D+0*RC0N( K , 2 , J ) + 

* RCON(K, 10 , J )+RCON( K , 4 , U ) ) 

ALPH=RCON( K , 10 , J )/( RCON( K , 10 , J ) +RCON ( K , 4 , J ) ) 
BET0(K,U)=(BET«*2/( 1 . D+O-BET ))*( ( 1 . D+O-BETA )/( BETA**2 ) ) 

* *( ( 1 . D+O-ALPH ) **2/ ( 1 . D+O-ALPHA )**2) 


1 142 


CONTINUE 

ENDIF 

ENDIF 


o o o 


1111  CONTINUE 

C QRW 

DO  200  K=3 , NXCON 
WRITE ( 8 , 102)  XPST(K) 

102  FORMAT ( /// , ' AT  X » '.D11.4) 

WQR=0.0 

DO  120  d«1,NPTS(K) 

TT=TEMP(K, d) 

CR(d , 1 )=3.6D-13*RC0N(K,2, 1 ) *DEXP( -5 . 7D+4/TT ) 

CR( d , 2 ) = 1 . 8D- 14*RC0N(K , 1 . 1 ) *DEXP ( -6 . 3D+4/TT ) 

CR ( d , 3 ) =3 . OD- 1 3*RC0N( K , 5 , 1 ) *DEXP ( -6 . 7D+4/TT ) 

CR( J , 4 ) =2 . ID- 19*RC0N( K , 5 , 1 ) *DEXP( -7 . 6D+3/TT ) 

SM=2 . 0D-20* ( RC0N(K , 3 , 1 )+RC0N(K,7. 1 ) ) *DEXP( -5 . 2D+04/TT ) 
CR(d,5)=SM»1 .OD-14 

SM=3 . 0D-20* ( RC0N( K , 4 , 1 )+RC0N(K,7, 1 ) )»DEXP( -4 . 2D+04/TT) 

CR( J , 6 ) = SM* 1 . OD- 14 
I F ( 105 . EO . 0)  THEN 

CR ( d , 7 ) = 1 ,D-1O*RC0N(K,3,d)*DEXP(-1 . 8D+05/TT ) * ALPN( K , J ) 
CR(d,8)=8.D-13»RC0N(K,3, d ) *DEXP ( -5 . 9D+04/TT ) *ALPN( K , d ) 
CR(d,9)=9.D-11*RC0N(K,4,d)*DEXP(-1 . 7D+05/TT ) *ALPO( K , d ) 

CR ( J , 10)=8.D-13*RCDN(K,4,d)»DEXP(-5. 9D+04/TT )*ALPD(K,J) 

I F ( 108 . EO . 0)  THEN 

CR(d, 1 3 ) - 1 . 6D-12*RC0N(K,8,d)*DEXP(-3. GD+04/TT ) *BETN( K , d ) 

ELSE 

CR( J, 13)«1 . 6D-12*RC0N(K,8, J ) »DEXP ( -3 . 6D+04/TT ) 

ENDIF 

ELSE 

CR ( d , 7 ) = 1 . D- 10*RCON( K ,3,d)*DEXP(-1 .8D+05/TT) 

CR(d,8)=8.D- 1 3*RCDN( K ,3,d)*DEXP(-5. 9D+04/TT ) 

CR  ( d , 9 ) =9 . D- 1 1*RC0N(K,4,d)*DEXP(-1 . 7D+05/TT ) 

CR ( d , 1O)=8.D-13*RC0N(K,4,d)*DEXP(-5. 9D+04/TT ) 

CR(d, 1 3 ) = 1 . 6D-12*RC0N(K,8,d)*DEXP(-3. 6D+04/TT ) 

ENDIF 

CR ( d , 1 1 )=9.D-33*( RCON( K , 9 , d )+RCON(K , 7 , d ) ) 

**DEXP ( - 1 . 4D+04/TT ) 

CR(  d , 12)=9.D-33»( RCON(K , 10 , d )+RCON(K , 7 , d ) ) 

**DEXP ( - 1 . 4D+04/TT ) 

120  CONTINUE 

DO  180  1 = 1 , 13 
dIN=  1 

RSUM=3 . 141 5927D+00*CR ( 1 , I ) *DABS( Y ( K , 1 )-YBDY(K) ) 

I F ( 109 . EO . 0)  WRITE(8, 2221 ) dIN.I.RSUM. 

DO  150  d=2 , NPTS ( K ) 

STSUM=0 . 5D+00* ( CR ( d , I )+CR(d-1 , I ) ) *DABS ( Y ( K , d- 1 ) -Y ( K , d ) ) 

C *2. D+00*3. 1415927 

I F ( 109 . EO . 0)  THEN 
WRITE ( 8 , 222 1 ) d.I.STSUM 

2221  FORMAT ( 1 X , ' AT  d =',I2,'  EQUATION  ',12,'  OR  =',D11.4) 

ENDIF 

RSUM=RSUM+STSUM 
150  CONTINUE 

WRITE ( 8 , 103 ) I.RSUM 

103  FORMAT (/ , ' FOR  EQUATION  ',12,'  OR  = ',D11.4,'  WATTS/SO . CM ) 
WQR=WOR+RSUM 

180  CONTINUE 

WRITE ( 8 , 101 ) WOR 

101  FORMAT (/ ' TOTAL  OR  = '.D11.4,'  WATTS/SO . CM .' ) 

200  CONTINUE 
RETURN 
END 


SUBROUTINE  ANDRAD  (104,105,109) 

IMPLICIT  REAL*8(A-H,0-Z) 

COMMON  /A  1 / TE1 ,TE2,M, IX, IMAX, IPSI .MODEL 

COMMON  / A3/  EVIINF(25) ,THETAI(25) ,MUI (25) , FI (25) .DELHI (25) , 

* Cl INF (25 ) ,LI(25) 

COMMON  / A5/  EPSIIL(20,25) ,GIL( 20 , 25 ) , CID( 200 , 50) 

COMMON  / A9/  EVIS(25) ,XPST( 100) 

COMMON  /RAD/  RCON( 100 , 10 . 40) , RRHO ( 100, 40) , TEMP ( 100 , 40 ) 

* , TSTAG , Y ( 100,40) .NXCON, NPTS ( 100) 

COMMON  /RADC/  YBDY ( 100) , B ( 100 , 8 , 40) , OPTL ( 100 , 8 , 40) 

COMMON  /RADO/  TEMPO ( 100 , 40) , ALPN( 100 , 40) , ALPO ( 100 , 40) 

REAL*8  KAPPA( 100,8,40) ,MUI 

WRITE ( 8 , 1 ) 

1 FORMAT ( /// ' ANDERSON  RADIATION  MODEL') 

C NUMBER  DENSITIES 

IF( (IQ4.EQ.5) .OR. (IQ4 . EQ.6) ) GO  TO  1111 
DO  10  K = 3, NXCON  , ,, 


DO  10  d* 1 , NPTS(K) 

DO  10  11*1, I MAX 
XXX*RRH0(K,d)*6 .023D+23 
XXX-XXX*RCON(K . I I . d)/MUI (II) 

10  RCON(K,II . d)-XXX 

C NONEOUI LIBRIUM  RADIATION  CORRECTION 

IF  (I05.E0.O)  THEN 
DO  122  K*3, NXCON 
DO  122  d* 1 , NPTS(K) 

I F ( d . EO . NPTS(K) ) THEN 
ALPN(K , d )*0 . D+00 
GO  TO  122 
END  IF 
01*0. D+0 
02*0.0+0 
03-0. D+0 

DO  112  III*1,LI(3) 

112  01*01+GIL(III,3) *DEXP( -EPSI IL( III, 3 )/TEMP(K, d ) ) 

DO  113  111*1, LI (9) 

113  Q2*Q2+GI L( I II,9)*DEXP(-EPSIIL(III, 9 )/TEMP(K, d) ) 

DO  130  111*1, LI(1) 

130  03-03+GI L( I I I , 1 )*DEXP( -EPSI IL( 111,1 )/TEMP(K, d) ) 

RH0 1 * RCON ( K , 3 , d ) * 1 . 40 1 D+0 1 /6 . 023D+23 
RH02*RC0N(K . 9 , d) • 1 . 401D+01/6 . 023D+23 
RH03«RC0N(K, 1 . d )*2 . 802D+01/6 .0230+23 
RH04-RH01+RH02+RH03 

OVI B - 1 . D+0/ ( 1 . D+O-DEXP ( -3 . 39D+03/TEMP ( K , d ) ) ) 

OROT  *TEMP(K , d)/5 . 8D+0 

C 1 *RH04*2 . 4701D+01 *QVIB*QR0T*Q3*DEXP( 1 . 135D+05/TEMP(K, d) ) 
C1-C1/(01**2*TEMP(K,d)**1.5) 

C2*RH04*8 . 909D+06*Q1 *DEXP( 1 . 69D+05/TEMP(K, d) ) 
C2*C2/(02*TEMP(K,d)**1 .5) 

ALPHA-0. 5D+0 
BETA-0.5D+0 

132  F*BETA**2*(1 .D+0-ALPHA)**2*C1+BETA-1 .D+0 

FA--2 .D+0*BETA**2*( 1 . D+O-ALPHA )*C1 
FB«2.D+0*BETA*( 1 .D+0-ALPHA)**2*C1+1 .D+0 
G-ALPHA**2*BETA*C2+ALPHA-1 .D+0 
GA=2.D+0*ALPHA*BETA*C2+1 .D+0 
GB«ALPHA**2*C2 
DENOM*FA*GB-FB*GA 
DA«( -F*GB+G*FB )/DENOM 
DB*(-G»FA+F*GA)/DENOM 
ALPHA-ALPHA+DA 
BETA-BETA+DB 

I F ( ( DABS ( DA ) . GT . 1 .D-05 ) . OR . (DABS(DB ).GT.1.D-5))  GO  TO  132 
ALPH*RCON(K , 9 , d )/( RCON(K , 9 , d)+RCON(K, 3 , d ) ) 

BET* ( RCON(K , 9 , d )+RCON(K, 3 , d) )/ (RCON(K, 9 , d)+RCON(K, 3 , d) 

* +2 .D+0*RCON(K, 1 , d ) ) 

ALPN(K,d)-(ALPH**2/( 1 .D+O-ALPH) )*( ( 1 . D+O-ALPHA )/( ALPHA**2 ) ) 

* *(BET/BETA) 

122  CONTINUE 

END  IF 

1111  CONTINUE 

C DENSITY  RATIOS 

DO  12  K*3 , NXCON 
DO  12  d-I.NPTS(K) 

I F ( 104 . EO . 4 ) RCON (K, 7 , d )*RCON(K , 7 , d)*RRHO(K , d) *6 . 023D+23/MUI ( 7 ) 
RRH0(K,d)*RRH0(K,d)/1 .2250D-03 
12  CONTINUE 

C PLANCK  FUNCTION 

DO  30  K-3, NXCON 
DO  30  d= 1 , NPTS(K) 

TT=TEMP(K,d)/ 168800.0 
C IF(TEMP(K,d).LE.8. D+03)  GO  TO  30 

BLACK =(TT*1 S8800 . ) **4*5 . 6696D- 12/3 . 1415927 
FF* 15 . D+00/ (3 . 1415927**4) 

XI =1 ,/TT 

B1=FF*(DEXP(-X1)*(6.+6.*X1+3.*X1 **2+X 1**3)+ 

C DEXP(-2.*X1 )*0.5*( .75+1 .5*X 1 + 1 . 5*X  1 **2+X1 **3 ) ) 

X 1 =0 . 935/TT 

B2  = FF*(DEXP(-X1)*(6.+6.*X1+3.*X1 **2+X  1**3)  + 

C DEXP ( -2 . *X 1 ) *0 . 5* ( . 75+ 1 . 5*X 1+ 1 . 5*X 1 **2+X 1**3)) 

X 1 *0 . 835/TT 

B3*FF* ( DEXP( -XI ) * (5 . +6 . *X 1+3 . *X 1 **2+X1 **3 )+ 

C DEXP (-2 . *X1 )*0.5*( .75+1 ,5*X1  + 1 . 5*X  1 **2+X 1 **3 ) ) 

X 1 =0 . 754/TT 

B4=FF*(DEXP(-X1 ) * (6 . +6 . *X1+3.*X 1 **2+X  1**3)  + 

C DEXP(-2.*X1)*0.5*( . 75+ 1 . 5*X 1+ 1 . 5*X1 **2+X 1 **3 ) ) 

X 1 =0 . 473/TT 


B6=FF*(DEXP(-X1 )*(6.+6. *X1+3. *X1*»2+X1**3)+ 

C DEXP(  -2  . *X  1 ) *0 . 5*  ( . 75+1 . 5+X1+1 . 5*.X  1 **2+X  1 **3 ) ) 

X1-0.213/TT 

B8=FF*(DEXP(-X1 ) * (6 . +6 . *X 1+3 . *X 1 * *2+X 1 **3 ) + 

C DEXP(-2.*X1 )*0.5*( .75+1 .5+X1+1 . 5*X 1 **2+X 1 **3 ) ) 

B8-1-B8 

B2=B2-B1 

B3-B3-B2 

B4-B4-B3 

B6-B6-B4 

B5=  1 -B8-B6-B4-B3-B2-B 1 
B( K , 1 , d ) =BLACK*B 1 
B(K, 2 , d ) =BLACK*B2 
B(K , 3 , d ) “BLACK *B3 
B(K,4,d)=BLACK*B4 
I F ( 105 . EO . 0)  THEN 
B(K, 1 ,d)-B(K, 1 ,d)*ALPN(K,d) 

B(K,2,d)«B(K,2,d)*ALPN(K,d) 

B(K,3.d)»B(K.3.d)*ALPN(K,d) 

B(K,4.d)»B(K,4td)*ALPN(K,d) 

END  IF 

B(K , € , d ) =BLACK*B6 

B ( K . 7 . d ) «BLACK»2 . 4D-2 1 *RCON( K . 7 . d ) *B6*DEXP ( . 1 62/TT ) 

B(K , 8 , d ) «BLACK*B8 
B(K,5.d)*BLACK*B5 

B(K, 1 ,d)«B(K. 1 ,d)+B(K,2.d)+B(K,3,d)+B(K.4.d) 
B(K,2,d)*B(Kt5,d)+B(K.6,d)+B(K,7,d)+B(K.8.d) 

30  CONTINUE 

C ABSORPTION  COEFFICIENTS 

00  20  K*3 , NXCON 
DO  20  d-1 ,NPTS(K) 

TT  *TEMP (K , d )/1 .0D+04 
I F (TEMP(K , d) . LE . 1 . 1D+04 ) THEN 
KAPPA ( K , 1 ,d)«36.D+00*RRHO(K,d)*TT**4.02 
ELSE 

KAPPA ( K , 1 , d ) “RRHO(K , d ) * ( 8 . 1D+00+4 1 . 3D+00+TT ) 

END  IF 

IF(TEMP(K,d) .LE.7.D+03)  THEN 
AA-234.7D+00 
BB“ 1 . 4 1D+00 
CC«7 . 83D+00 
GO  TO  25 
ENDIF 

IF (TEMP(K, d) . LE . 9 . D+03 ) THEN 
AA*262 . D+OC 
BB«1 .40+00 
CC=8. 19D+00 
GO  TO  25 
ENDIF 

IF(TEMP(K,d) .LE. 1 . 1D+04 ) THEN 
AA“266 . D+00 
BB«1 . 15D+00 
CC= 1 3 . 86D+00 
GO  TO  25 
ENDIF 

I F (TEMP ( K , d ) . LE . 1 . 3D+04 ) THEN 
AA=232 . D+00 
BB* 1 . 06D+00 
CC= 1 3 . 1D+00 
GO  TO  25 
ENDIF 

AA*406 . 5D+00 
BB= 1 . 1D+00 
CC=1 1 . 3D+00 

25  dP=AA*RRHO(K,d)**BB*TT**CC 
IF(B(K,2,d).LE. 1.D-05)  THEN 
KAPPA (K , 2 , d ) =0 . D+00 
GO  TO  20 
ENDIF 

KAPPA(K,2.d)=dP/B(K,2,d) 

I F ( 105 . EO . 0)  THEN 

KAPPA(K,2,d)=KAPPA(K,2,d)*ALPN(K,d) 

ENDIF 

20  CONTINUE 

C TAU'S 

DO  100  K=3, NXCON 
DO  100  1=1,2 

OPTL ( K , I , 1 )=5.D-01*KAPPA(K,I , 1 )*DABS(Y(K, 1 ) -YBDY ( K ) ) 

DO  100  d=2 , NPTS(K ) 

OPTL(K, I ,d)=OPTL(K, I , d- 1 )+ (0 . 5* ( KAPPA ( K , I ,d)+KAPPA(K, I ,d-1 ) )* 


DABS(Y(K, J-1)-Y(K, J))) 


C 

100  CONTINUE 

C QRW 

DO  200  K*3 . NXCON 
WRITE(8. 102)  XPST(K) 

102  FORMAT ( /// , ' AT  X E '.D11.4) 

WQR-0.0 

DO  180  1*1,2 

CALL  FEI(E1I,E2I,E3I ,OPTL(K, 1,1)) 

E0LD*E2 I 
JIN*  1 

SUM=3 . 1415927*E0LD*B(K, I . 1 )*KAPPA(K, 1,1) *DABS( Y (K. 1 ) -YBDY ( K ) ) 
I F ( 109 . EO . O)  WRITE ( 8 , 222 1 ) JIN.I.SUM 
DO  150  J*2 , NPTS ( K ) 

2*0PTL(K , I . J) 

I F ( Z . EO . 0 . D+0)  THEN 
E2I * 1 . D+0 
GO  TO  145 
END  IF 

CALL  FEI(E1I,E2I,E3I,Z) 

STSUM*3. 14159*(B(K.I , J)*KAPPA(K, I , J ) *E2I+B(K , I . J- 1 ) * 

C KAPPA (K. I , J-1 )*EOLD)*DABS(Y(K, J-1 )-Y(K, J) ) 

I F ( 109 . EO.O)  THEN 
WRITE ( 8 , 222 1 ) J.I.STSUM 

2221  FORMAT ( IX , ' AT  J -',12/  BAND  '.12.'  OR  *',011.4) 

ENDIF 

145  SUM*SUM+STSUM 
E0LD-E2I 
150  CONTINUE 

WRITE ( 8 , 103 ) I, SUM 

103  FORMAT  ( / , ' FOR  BAND  M2,'  OR  * ',D11.4,'  WATTS/SO . CM .'  ) 
WQR*WQR+SUM 

180  CONTINUE 

WRITE ( 8 , 101 ) WQR 

101  FORMAT ( / ' TOTAL  OR  * '.D11.4,'  WATTS/SO . CM .' ) 

200  CONTINUE 

I F ( ( 104 . EO . 5 ) . OR . ( 104 . EO . 6 ) ) THEN 
DO  1000  K=3 , NXCON 
DO  1000  ds 1 , NPTS (K ) 

RRHO(K, J)=RRHO(K, J)* 1 .225D-03 
1000  CONTINUE 
ENDIF 
RETURN 
END 


LISTING  OF  INPUT  FILE  KDRW 


im  (,& 


10.22.83146900. . 1.4 

20. . 5.65. .3. .01 

3392. 14.28.016.1.0.  .768.4. 1 . 1 14981 . .0,-. 42 163 

2275. . 32. . 1 .0. .232.6. 1.60500. .0.1.21618 

1 . 1 4 . 008 .0. 4. 707  E+ 12,0,4, 1 ,0,0, 1 .67997 

1 . 16. . 0.2. 4681 E+ 12, 0.5, 1 ,0.0.2. 1032 

2739  .30.008, 1 .9.0073E+1 1 ,0.8,1 ,76883. .0,1 .23256 

3421. . 30.008. 1. 1 .0826E+13.0.3, 1. 127698. .0, .3786099 
1 ,5.4862E-04,0.0,0, 1 , 1 .0,0,-14.23517 

3129. . 28.016. 1 . 1 . 505E+ 13 ,0,4, 1, 101242.3,0. 1 .00426 

1 . 14.008.0.  1 . 8759E+ 13,0,6, 1 .0,0, .29368 

1 . 16. . 0. 1 .5625E+13.0.5, 1 ,0.0, 1.8794 
2. 1 . 19E+2 1,-1 .5,59380. . 1 . 

5,5. 18E+21 , -1 .5,75490. , 1 . 

3,5. 0E+ 19,-1 .5,0,2. 

2, 1 .OE+12, 0.5, 3120. , 1 . 

1 , 5. 0E+13, 0,38016. . 1 . 

6, 1 .8E+21 ,-1 .5,0, 1 . 

3, 1 .4E+13.0, 67800, 1 . 

3,2. 34E+ 1 1 .0.5, 120000, 1 . 

9.2.34E+1 1 ,0.5, 120000, 1 . 

3,4. 16E+ 13, 0.500. 120000, 1 . 

4,5.49E+13,0. 500, 104500. . 1 . 

4.2. 

3.2. 

1.1. 

5.2. 

5.2. 

8.2. 

9,2. 

9,2. 

9,2. 

9.2. 

10.2. 

64. 1 

64.1 

64. 1 

64,1 

64, 1 

64,1 

64, 1 

64,1 

64,1 

64,1 

64,1 

64, 1 

64,1 

64,1 

64, 1 

64, 1 

64, 1 

64, 1 

64, 1 

64, 1 

64,1 

1 , 1,  1 , 1 , 1 , 1 ,0,0, 0.0, 0,0, 0,0, 0,0, 0,0, 0,0, 0.0 

1,1, 1.1. 1,1. 0,0, 0,0, 0,0. 0,0, 0,0, 0,0, 0.0. 0,0 

1,1, 1,1. 1.1. 0.0, 0,0, 0,0, 0,0. 0,0, 0,0, 0,0, 0,0 

1,1,1, 1,1, 1,0, 0,0, 0,0, 0.0, 0,0, 0,0, 0,0, 0,0,0 

1,1, 1.1. 1.1, 0,0. 0,0, 0,0, 0,0, 0,0, 0,0, 0,0, 0,0 
1 , 1 , 1 , 1 , 1 , 1 ,0.0, 0,0, 0,0,0, 0.0. 0,0,0, 0,0. 0,0 
0,0, 0,0, 0.0, 0.0, 0,0, 0,0, 0,0. 0,0, 0,0, 0.0, 0,0 

1,1, 1,1, 1,1, 0,0, 0.0, 0,0, 0,0, 0,0, 0.0. 0,0, 0.0 

1,1, 1.1. 1.1. 0.0, 0.0, 0,0, 0,0, 0.0, 0,0, 0,0, 0,0 

1,1, 1,1, 1,1, 0.0, 0,0, 0,0, 0,0, 0,0, 0,0, 0,0, 0,0 
0, 1 ,0,0, 0.0, 0,0, 0,0, 1 
0,0,0, 2, 0.0, 0,0, 0.0, 1 
0,0, 0,0, 1 ,0,0, 0,0,0. 1 
0,0,1, 1 ,0,0, 0,0, 0,0, 1 

1 ,0.0, 0,0, 0,0, 0,0,0, 1 
0,0, 2, 0,0, 0,0, 0,0,0. 1 
0,  1 , 1 ,0, 0.0,0, 0,0, 0.0 
0,0,0, 1 . 1 ,0,0, 0.0. 0,0 

1 ,0.0, 1 ,0,0, 0,0, 0,0.0 
0,0, 1 ,0, 1 ,0,0, 0,0, 0,0 
0,0, 0,0.0, 1 , 1 ,0,0, 0,0 
0,0. 1 , 1 ,0,0, 0.0, 0,0,0 
0.0. 2. 0,0, 0.0. 0,0, 0,0 
0, 0,0, 0,0,0, 1 , 1 ,0,0.0 
0,0, 2, 0,0, 0,0, 0,0, 0,0 


0,0, 1 ,0,0,0, 1.0, 1 .0.0 
0,0, 1 ,0.0. 0,0,0, 1,0,0 
0,0, 0,0, 0,0, 1 ,0.2, 0.0 
0,0, 1 ,0,0,0, 1 ,0.0, 0,0 
0,0, 0,0, 0.0, 2.0, 1 .0,0 
0,0,0, 1,0,0, 1 ,0,0, 0.0 
0.0.0, 0,0,0, 2,0.0. 1 ,0 
0.0,0, 2, 0,0, 0,0, 0,0 
0, 1 ,0,0, 0,0,0, 0,0,0 
0,0, 1 . 1 ,0,0, 0,0, 0,0 
0, 0,0,0, 1 ,0.0,0, 0,0 
0.0, 2, 0,0, 0.0, 0.0,0 
1 , 0,0, 0,0,0, 0.0,0. 0 
0,0,0, 1 , 1 ,0,0, 0,0,0 
0. 1 , 1 ,0.0, 0,0, 0,0,0 
0.0. 1,0,1 ,0.0, 0,0,0 
1 ,0,0, 1 .0,0, 0,0, 0.0 
0.0, 1 , 1 ,0,0,0, 0,0,0 
0.0, 0,0,0, 1 . 1 .0,0,0 
0.0, 0,0, 0,0, 1 . 1 ,0,0 
0,0, 2. 0,0, 0.0, 0,0,0 
0.0. 1 ,0,0,0. 1 ,0, 1 ,0 
0,0, 2, 0,0, 0,0, 0,0,0 
0,0, 0,0, 0.0. 1 ,0,2.0 
0,0, 1 ,0,0, 0,0,0, 1 ,0 
0,0, 0.0. 0,0, 2.0, 1 ,0 
0,0, 1 ,0,0,0, 1 ,0,0,0 
0.0, 0,0, 0,0, 2,0,0, 1 
0,0,0, 1,0,0, 1 ,0,0,0 

5 . 67 5 E -04 , 5 . 675 E -04 , 5 . 67 5 E -04 , 5 . 67 5 E -04 ,5.675E-04,5. 675 E -04 , 5 . 6 75 E -04 , 5 . 6 75 E -04 
5.675E-04.5.675E-04 

1 .443E-07, 1 .443E-07, 1 .443E-07, 1 .443E-07, 1 .443E-07, 1 .443E-07, 1 .443E-07, 1 .443E-07 
1 .443E-07, 1 . 443E-07 
0.0, 0,0, 0,0, 0,0, 0,0 
0,0, 0,0, 0,0,0, 0,0,0 

1 .513E-04, 1 .513E-04, 1 .513E-04. 1 . 513E-04, 1 . 513E-04, 1 . 513E-04, 1 . 513E-04, 1 .513E-04 
1 .513E-04, 1 .513E-04 

1 .513E-04, 1 .513E-04, 1 .513E-04, 1 .513E-04, 1 .513E-04, 1 .513E-04, 1 .513E-04, 1 .513E-04 
1 .513E-04, 1 . 5 1 3E-04 
0,0,0, 0,0, 0,0, 0,0,0 

5.675E-04.5. 67 5 E -04 , 5 . 675 E -04 , 5 . 675 E -04 ,5.675E-04,5.675E-04,5. 675 E -04 , 5 . 675E-04 
5 . 675 E -04 , 5 . 67 5 E -04 
0,0, 0,0,0, 0.0, 0,0,0 
0,0, 0,0,0, 0,0, 0,0,0 

- . 09952 , - . 09952 , - . 09952 , - . 09952 , - . 09952 , - . 09952 , - . 09952 , - . 09952 , - . 09952 , - . 09952 
.37177, .37177, .37177, .37177, .37177, .37177, .37177, .37177, .37177, .37177 
0,0, 0,0, 0,0, 0,0, 0,0 
0,0, 0,0, 0,0, 0,0, 0,0 

- . 2226 , - . 2226 , - . 2226 , - . 2226 , - . 2226 , - . 2226 , - . 2226 , - . 2226 , - . 2226 , - . 2226 
- . 2226 , - . 2226 , - . 2226 , - . 2226 , - . 2226 , - . 2226 , - . 2226 , - . 2226 , - . 2226 , - . 2226 
0,0, 0.0, 0,0, 0,0, 0.0 

- .09952, - .09952, - .09952, - .09952, - . 09952 , - . 09952 , - . 09952 , - . 09952 , - . 09952 , - . 09952 
0,0, 0,0, 0,0, 0,0, 0,0 
o,o,o,o,o,o,o,o,o,o 

163.63,163.63,163.63,163.63,163.63,163.63,163.63,163.63,163.63,163.63 
179.32,179.32,179.32,179.32,179.32,179.32,179.32,179.32,179.32,179.32 
0,0, 0.0, 0,0,0, 0,0,0 
0,0, 0,0, 0,0, 0,0, 0,0 

135.3,135.3,135.3,135.3,135.3,135.3,135.3,135.3,135.3,135.3 

135.3.135.3.135.3.135.3.135.3.135.3.135.3.135.3.135.3.135.3 
0,0, 0,0,0, 0,0, 0,0,0 

163.63,163.63,163.63,163.63,163.63,163.63,163.63,163.63,163.63,163.63 
0,0,0, 0,0,0, 0,0,0, 0 
0, 0,0,0, 0,0,0, 0,0,0 

1 .3.6.2 

3.2. 1 .3. 1 .3 
4, 6, 4, 6 

5.3. 1 .5,  1 

2, 2, 2, 4, 2, 4, 2, 4 

1.6.3 
1 

2.4. 2.2 

1 .3.5.5,  1 ,5 

4. 6.4. 4. 2 

0,71592,85343,99212 
0, 11342, 18879,51385,52104,71026 
0,27659,27670,41496 
0,228,326,22831 ,48622 

0, 174,63597,65381 ,76676,75361 ,87568,86359 
0.57528,84205 


0 

0, 13191 , 36634 ,92977.4 

0,70.5.188.5. 22036 . 5 , 47029 . 68 . 67864 . 8 
0, 3857 1 , 38601 . 58223 . 5 . 58225 

46. 18800.3393.9685,20.797195,1 . 0801 997E-02 . -7 . 32343E-04 
33.9896,2273. 1279, 1 7 . 365295 , 7 . 8529954E-02 , -2 . 057468E-03 
0,0, 0,0, 0.0 
0,0, 0,0, 0,0 
0.0, 0.0. 0.0 
0,0, 0,0, 0,0 
0.0, 0.0, 0,0 

50. 1 6850 , 3175.68,23 .21629, -5.7551 54E-02 , 0 
0.0, 0,0, 0,0 
0.0. 0,0, 0.0 
N2 
02 
N 
0 

NO 

N0+ 

E- 

N2+ 

N+ 

0+ 

02_+_M. . >20_+_M 
20l+_M. .>02_+_M 
NO_+_M . . >N_+_0_+_M 
N_+_0_+__M . . >NO_+_M 
N2_+_M. ,>2N_+_M 
2N_+_M . . >N2_+_M 
N_+_02 . . >N0_+_0 
N0_+_0 . . >N_+_02 
N2_+_0 . . >N0  +_N 
NO_+_N . . >N2_+_0 
N0+_+_E- . . >N_+_0 
N_+_0 . .>NO+_+_E- 
N~+_N. ->N2+_+_E- 
N2+_+_E-  . .>N_+_N 
N__+_N  . . >N+_+__E  -_+_N 
N+_+_E-_+_N . . >N_+_N 
N+ . . >N+_+_E -_+_N+ 

N+_+_E  -__+_N+  . . >N_+_N+ 

N_+_E - . . >N+_+_2  E - 
N+_+__2E-  . .>N_+_E- 
0_+_E- . >0+_+_E-_+_E- 
0+  + E-  + E- . >0  + E - 


PORTION  OF  A SAMPLE  OUTPUT 


SPECIES 


1 

2 

3 

4 

5 

6 

7 

8 
9 

10 


N2 

02 

N 

0 

NO 
N0+ 
E- 
N2  + 
N+ 
0+ 


REACTIONS 


1 

02  + M. .>20  + M 

2 

20  +"M. .>02  + M 

3 

NO  + M . . >N  + 0 + M 

4 

N + 0 . . >NO~+_M 

5 

N2  + M.T>2N  + M 

6 

2N  + M. . >N2  + M 

7 

N + 02 . . >N0  + 0 

8 

NO  + 0. .>N  + 02 

9 

N2  + 0. . >N0  + N 

10 

NO_+_N . . >N2_+~0 

1 1 

NO+_+_E- . . >N_+_0 

12 

N + 0 . . >N0+  * E- 

13  ■ 

N + N. . >N2  + + E- 

14 

N2+_+_E-. . >N_+_N 

15 

. . >N+_+_E-_+_N 

16 

N+_+_E-_+_N . • >N_+~N 

17 

N_+_N+  . . >N+_+_E J 

18 

N+  + E-  + N+ . . >N  +~l 

19 

N + E-.7>N+  + 2E- 

20 

1 

UJ 

£ 

A 

1 

Ui 

CM 

£ 

2 

21 

0 + E- . >0+  + E-  + E- 

22 

UJ 

I 1 
+ 

1 1 

0 

A 

1 * 

1 

|UJ 

1 

UJ 

o 

HCHCKT  * 

0 

. 1000E-01 

TCHCKT  « 0 . 3000E+00  PHMAX  » 0.6500E+02 

XI  « 0. 

1221E-03 

CIMAX  « 0.5000E+00  NXPST  * 20 

ELE1(  1) 

c 

0 . 6400E+02 

ELE2(  1)  * 

0. 1000E+01 

ELE 1 ( 2) 

z 

0.6400E+02 

ELE2(  2)  « 

0. 1000E+01 

ELE1(  3) 

s 

0 . 6400E+02 

ELE2(  3)  « 

0. 1000E+01 

ELE 1 ( 4) 

2 

0 . 6400E+02 

ELE2(  4)  » 

0. 1000E+01 

ELE 1 ( 5) 

s 

0 . 6400E+02 

ELE2(  5)  * 

0. 1000E+01 

ELE 1 ( 6) 

s 

0 . 6400E+02 

ELE2(  6)  * 

0. 1000E+01 

ELE 1 ( 7) 

s 

0 . 6400E+02 

ELE2(  7)  = 

0. lOOOE+OI 

ELE 1 ( 8) 

= 

0 . 6400E  + 02 

ELE2 ( 8)  « 

0. 1000E+01 

ELE 1 ( 9) 

= 

0 . 6400E+02 

ELE2 ( 9)  * 

0. 1000E+01 

ELE 1 ( 10) 

E 

0 . 6400E+02 

ELE2( 10)  - 

0. 1000E+01 

ELE 1 ( 1 1 ) 

S 

0 . 6400E+02 

ELE2 ( 11)  = 

0. 1000E+01 

ELE1 ( 12) 

E 

0 . 6400E+02 

ELE2( 12)  = 

0. 1000E+01 

ELE1( 13) 

S 

0 . 6400E+02 

ELE2 ( 13)  * 

0. 1 000E+01 

ELE1( 14) 

E 

0 . 6400E+02 

ELE2( 14 ) ’* 

0. lOOOE+OI 

ELE1( 15) 

E 

0 . 6400E+02 

ELE2(  1 5 ) » 

0. 1000E+01 

ELE 1 ( 16 ) 

S 

0.6400E+02 

ELE2( 16 ) * 

0. 1000E+01 

ELE 1 ( 17) 

Z 

0.6400E+02 

ELE2 ( 17)  = 

0. 1000E+01 

ELE 1 ( 18) 

S 

0.6400E+02 

ELE2 ( 1 8 ) * 

0. 1000E+01 

ELE 1 ( 19) 

E 

0.6400E+02 

ELE2 ( 19 ) = 

0. 1000E+01 

ELE 1(20) 

E 

0.6400E+02 

ELE2 ( 20)  = 

0. 1000E+01 

ELE 1 ( 2 1 ) 

S 

0 . 6400E+02 

ELE2(2 1 ) = 

0. 1000E+01 

XPST  ( 

D 

0.5000E+00 

XPST  ( 

2) 

= 

0. 1000E+01 

XPST  ( 

3) 

S 

0. 1500E+01 

XPST  ( 

A) 

S 

0.2000E+01 

XPST  ( 

5) 

= 

0.2500E+01 

3 


XPST ( 6) 
XPST ( 7) 
XPST ( 8) 
XPST ( 9) 
XPST(  10) 
XPST ( 11) 
XPST ( 12) 
XPST ( 13) 
XPST ( 14) 
XPST ( 15) 
XPST(  16) 
XPST ( 17) 
XPST ( 18) 
XPST ( 19) 
XPST ( 20) 


0 . 3000E+01 
0. 3500E+01 
0 . 4000E+01 
0. 4500E+01 
0 . 5000E+01 
0.5500E+01 
0.6000E+01 
0.6500E+01 
0 . 7000E+01 
0.7500E+01 
0 . 8000E+01 
0.8500E+01 
0 . 9000E+01 
0 . 9500E+01 
0. 1000E+02 


IMAX  ■ 10 

DELX  « 0 . 5000E+00 

PINF  * 0.1572E+02 


UMAX  « 22 

ZSTERM  « 0.2000E+00 

TINF  - 0.197 1 E+03 


M « 1 

PRINT  FREQ.  « 50 

VINF  - 0. 8915E+06 


R « 0.8315E+08 

GAMMA  * 0.140E+01 


MU  I 

THETA I 

DGENI 

FI 

DELHI 

1 

0. 2802E+02 

0 . 3392E+04 

0. 1000E+01 

0. 1000E+01 

0. OOOOE+OO 

2 

0.3200E+02 

0.2275E+04 

0. lOOOE+OI 

0. 1000E+01 

0. OOOOE+OO 

3 

0. 1401E+02 

0. lOOOE+OI 

0. lOOOE^OI 

0 . OOOOE+OO 

0.4707E+13 

4 

0. 1600E+02 

0. 1000E+01 

0. 1000E+01 

O.OOOOE+OO 

0 . 2468E+ 13 

5 

0.3001E+02 

0.2739E+04 

0 . 1000E+01 

0. 1000E+01 

0. 9007E+ 1 2 

6 

0.3001E+02 

0.3421E+04 

0. 1000E+01 

0. lOOOE+OI 

0. 1083E+14 

7 

0 . 5486E-03 

0. 1000E+01 

0. lOOOE+OI 

0. OOOOE+OO 

0. OOOOE+OO 

8 

0 . 2802E+02 

0 . 3 129E+04 

. 0.1000E+01 

0. 1000E+01 

0. 1505E+ 14 

9 

0. 1401 E+02 

0. 1000E+01 

0. lOOOE+OI 

0. OOOOE+OO 

0.  1876E+ 14 

10 

0. 1600E+02 

0. 1000E+01 

0. 1000E+01 

0. OOOOE+OO 

0.  1562E+14 

DELI 

Cl  INF 

EVI 

LI 

BI 

1 

C. 1 150E+06 

0 . 7680E+00 

0. OOOOE+OO 

4 

“0 . 42 16E+00 

2 

0 . 6050E+05 

0 . 2320E+00 

0. OOOOE+OO 

6 

0. 1216E+01 

3 

0. OOOOE+OO 

0. OOOOE+OO 

0. OOOOE+OO 

4 

0. 1680E+01 

4 

0. OOOOE+OO 

0. OOOOE+OO 

0. OOOOE+OO 

5 

0 . 2 103E+01 

5 

0 . 7688E+05 

0. OOOOE+OO 

0. OOOOE+OO 

8 

0. 1233E+01 

6 

0.  1277E+06 

0. OOOOE+OO 

0. OOOOE+OO 

3 

0 . 3786E+00 

7 

0. OOOOE+OO 

0. OOOOE+OO 

0. OOOOE+OO 

1 

-0. 1 424E+02 

8 

0. 1012E+06 

0. OOOOE+OO 

0. OOOOE+OO 

4 

0. 1004E+0 1 

9 

0. OOOOE+OO 

0. OOOOE+OO 

0. OOOOE+OO 

6 

0 . 2937E+00 

10 

0. OOOOE+OO 

0. OOOOE+OO 

0 . OOOOE+OO 

5 

0. 1879E+01 

NIP 

UP 

WE 

W EXE 

WEYE 

WEZE 

1 

46 

0. 1 880E+05 

0 . 3394E+04 

0 . 2080E+02 

0. 1080E-01 

- . 7323E -03 

2 

33 

0 . 9896E+04 

0 . 2273E+04 

0. 1 737E+02 

0.7853E-01 

- . 2057E-02 

3 

0 

0. OOOOE+OO 

0. OOOOE+OO 

0. OOOOE+OO 

0. OOOOE+OO 

0. OOOOE+OO 

4 

0 

0. OOOOE+OO 

0. OOOOE+OO 

0. OOOOE+OO 

0. OOOOE+OO 

0. OOOOE+OO 

5 

0 

0. OOOOE+OO 

0. OOOOE+OO 

0. OOOOE+OO 

0. OOOOE+OO 

0. OOOOE+OO 

6 

0 

0. OOOOE+OO 

0. OOOOE+OO 

0. OOOOE+OO 

0. OOOOE+OO 

0. OOOOE+OO 

7 

0 

0. OOOOE+OO 

0. OOOOE+OO 

0. OOOOE+OO 

0. OOOOE+OO 

0. OOOOE+OO 

8 

50 

0. 1685E+05 

0 . 3 1 76E+04 

0 . 2322E+02 

-.5755E-01 

0. OOOOE+OO 

9 

0 

0. OOOOE+OO 

0. OOOOE+OO 

0. OOOOE+OO 

0. OOOOE+OO 

0. OOOOE+OO 

10 

0 

0. OOOOE+OO 

0. OOOOE+OO 

0. OOOOE+OO 

0 . OOOOE+OO 

0. OOOOE+OO 

MJ 

AJ 

BJ 

EJ 

DIRECTION 
F«1  tB«2 

1 

2 

0. 1 1 9000E+22 

-0. 150000E+01 

0 . 593800E+05 

1 .00 

3 

5 

0.51 8000E+22 

-0. 1 50000E+01 

0 . 754900E+05 

1 .00 

5 

3 

0 . 500000E+20 

-0. 1 50000E+01 

0. OOOOOOE+OO 

2.00 

7 

2 

O. 100000E+ 13 

0 . 500000E+00 

0.31 2000E+04 

1 .OO 

o 

1 

0 . 500000E+ 14 

0 . OOOOOOE+OO 

0 . 380 1 60E+05 

1 .00 

1 1 

6 

0. 1 80000E+22 

-0. 1 50000E+01 

0. OOOOOOE+OO  ‘ 

1.00 

13 

3 

0. 140000E+ 14 

0. OOOOOOE+OO 

0 . 678000E+05 

1 .00 

15 

3 

O . 234000E+ 1 2 

0 . 500000E+00 

0. 120000E+06 

1 .00 

17 

9 

0.234000E+12 

0 . 500000E+00 

0. 1 20000E+06 

1 .00 

19 

3 

0.416000E+14 

0,  500000E+00 

0. 120000E+06 

1 .00 

21 

4 

0 . 549000E* 14 

0.500000E+00 

0.  104500E+06 

1 .00 

MJ 

DIRECTION 
F*  1 ,B*2 

2 

4 

2.00 

4 

3 

2.00 

6 

1 

1.00 

8 

5 

2.00 

10 

5 

2.00 

12 

8 

2.00 

14 

9 

2.00 

16 

9 

2.00 

18 

9 

2.00 

20 

9 

2.00 

22 

10 

2.00 

GIL( 

1 . 

1) 

0. 1000E+01 

EPSIILC 

1. 

GIL( 

2. 

1) 

0.3000E+01 

EPSI IL( 

2 , 

GIL( 

3. 

D 

O.GOOOE+OI 

EPSI IL( 

3, 

GIL( 

4, 

1) 

0. 2000E+01 

EPSIIL( 

4, 

GI  L ( 

1 . 

2) 

0 . 3000E+01 

EPSI I L( 

1 , 

GIL( 

2, 

2) 

0 . 2000E+01 

EPSI I L( 

2, 

GIL( 

3, 

2) 

0. lOOOE+OI 

EPSIIL( 

3. 

GIL( 

4. 

2) 

0 . 3000E+01 

EPSI I L( 

4, 

GI  L ( 

5 * 

2) 

0. 1000E+01 

EPSI I L( 

5. 

GIL( 

6. 

2) 

0 . 3000E+01 

EPS I I L ( 

6 , 

GIL( 

1. 

3) 

0.4000E+01 

EPSI  IL( 

1 . 

GI  L ( 

2, 

3) 

0.6000E+01 

EPSI  I L ( 

2. 

GI  L ( 

3. 

3) 

0.4000E+01 

EPSI  I L( 

3, 

GIL( 

4, 

3) 

0 . 6000E+01 

EPSI  IL( 

4, 

GI  L( 

1 f 

4) 

0.5000E+01 

EPSIIL( 

1 , 

GI  L ( 

2. 

4) 

s 

0.3000E+01 

EPSI  I L ( 

2, 

GIL( 

3. 

4) 

0. lOOOE+OI 

EPSI IL( 

3. 

GIL( 

4 . 

4) 

0 . 5000E+01 

EPSI I L( 

4. 

GIL( 

5. 

4) 

= 

0. lOOOE+OI 

EPSI I L( 

5. 

GIL( 

1 , 

5) 

0 . 2000E+01 

EPSI I L( 

1 , 

GI  L( 

2. 

5) 

0.2000E+01 

EPSI I L ( 

2 , 

GI  L ( 

3, 

5) 

X 

0.2000E+01 

EPSI I L ( 

3, 

GI  L ( 

4, 

5) 

0 . 4OOOE+01 

EPSIILC 

4 , 

GIL( 

5, 

5) 

X 

0.2000E+01 

EPSIILC 

5, 

GI  L ( 

6, 

5) 

0.4000E+01 

EPSIILC 

6, 

GI  L ( 

7, 

5) 

X 

0 . 2000E+01 

EPSI IL( 

7, 

GIL( 

8. 

5) 

0.4000E+01 

EPSI I L ( 

8, 

GI  L ( 

1 , 

6) 

s 

O. lOOOE+OI 

EPSIIL( 

1 , 

GI  L ( 

2. 

6) 

X 

0 . 60O0E+01 

EPSIILC 

2. 

GI  L ( 

3. 

6) 

= 

0.3000E+01 

EPSIILC 

3, 

GI  L ( 

1 , 

7) 

X 

0. lOOOE+OI 

EPSIILC 

1 , 
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2) 

0.  1 793E+03 

ALPIK( 

3, 

2) 

• 

0.  1443E-06 

BETAIKC 

3. 

2) 

■ 

0 . 37 18E+00 

SIGIK( 

3. 

3) 

O.OOOOE+OO 

ALPIK( 

3. 

3) 

B 

O.OOOOE+OO  BETAIKC 

3. 

3) 

• 

O.OOOOE+OO 

SIGIK( 

3. 

4) 

O.OOOOE+OO 

ALPIK( 

3. 

4) 

* 

O.OOOOE+OO 

BETAIKC 

3. 

4) 

■ 

O.OOOOE+OO 

SIGIK( 

3. 

5) 

0. 1 353E+03 

ALPIK( 

3, 

5) 

B 

0. 1513E-03 

BETAIKC 

3. 

5) 

B 

- . 2226E+00 

SIGIK( 

3. 

6) 

0. 1 353E+03 

ALPIK( 

3. 

6) 

m 

0.  1513E-03 

BETAIKC 

3, 

6) 

* 

- . 2226E+00 

SIGIK( 

3, 

7) 

O.OOOOE+OO  ALPIK( 

3. 

7) 

m 

O.OOOOE+OO  BETAIKC 

3. 

7) 

B 

O.OOOOE+OO 

SIGIK( 

3. 

8) 

0. 1 636E+03 

ALPIK( 

3. 

8) 

s 

0 . 5675E-03 

BETAIKC 

3. 

8) 

m 

-.9952E-01 

SIGIK( 

3, 

9) 

O.OOOOE+OO 

ALPIK( 

3. 

9) 

M. 

O.OOOOE+OO 

BETAIKC 

3. 

9) 

m 

O.OOOOE+OO 

SIGIKC 

3. 10) 

O.OOOOE+OO 

ALPIK( 

3. 

10) 

B 

O.OOOOE+OO 

BETAIKC 

3.  10) 

■ 

O.OOOOE+OO 

SIGIK( 

4. 

1) 

0. 1636E+03 

ALPIK( 

4. 

1) 

B 

0. 5675E-03 

BETAIKC 

4 , 

1) 

* 

- .9952E-01 

SIGIKC 

4 , 

2) 

0.  1 793E+03 

ALPIK( 

4. 

2) 

B 

0.  1443E-06 

BETAIKC 

4,  2) 

s 

0 . 37 18E+00 

SI GIK( 

4. 

3) 

O.OOOOE+OO 

ALPIKC 

4, 

3) 

s 

O.OOOOE+OO 

BETAIKC 

4, 

3) 

K 

O.OOOOE+OO 

SIGIK( 

4, 

4) 

O.OOOOE+OO 

ALPIK( 

4 , 

4) 

b 

O.OOOOE+OO 

BETAIKC 

4, 

4) 

m 

O.OOOOE+OO 

SIGIK( 

4, 

5) 

0. 1 353E+03 

ALPIKC 

4, 

5) 

m 

0.  1513E-03 

BETAIKC 

4. 

5) 

B 

- . 2226E+00 

SIGIK( 

4,  6) 

0.  1 353E+03 

AIPIK( 

4, 

6) 

* 

0.  1513E-03 

BETAIKC 

4, 

6) 

m 

- . 2226E+00 

SIGIK( 

4, 

7) 

O.OOOOE+OO 

ALPIK( 

4, 

7) 

m 

O.OOOOE+OO 

BETAIKC 

4, 

7) 

s 

O.OOOOE+OO 

SIGIK( 

4, 

8) 

0. 1636E+03 

ALPIKC 

4, 

8) 

b 

0.5675E-03 

BETAIKC 

4, 

8) 

m 

-.9952E-01 

SIGIKC 

4 , 

9) 

O.OOOOE+OO 

ALPIK( 

4, 

9) 

E 

O.OOOOE+OO 

BETAIKC 

4 . 

9) 

B 

O.OOOOE+OO 

SIGIK( 

4. 10) 

O 

b 

0 

0 

0 

m 

+ 

8 

ALPIK ( 

4, 

10) 

K 

O.OOOOE+OO 

BETAIKC 

4. 10) 

B 

O.OOOOE+OO 

SIGIK( 

5. 

1) 

0. 1 636E+03 

ALPIK( 

5, 

1) 

E 

0 . 5675E-03 

BETAIKC 

5, 

1) 

B 

- .9952E-01 

SIGIK( 

5. 

2) 

0.  1 793E+03 

AIPIK( 

5. 

2) 

E 

0.  1443E-06 

BETAIKC 

5, 

2) 

B 

0.3718E+00 

SIGIK( 

5, 

3) 

O.OOOOE+OO 

ALPIK( 

5, 

3) 

O.OOOOE+OO 

BETAIKC 

5, 

3) 

B 

O.OOOOE+OO 

SIGIK( 

5. 

4) 

O.OOOOE+OO 

ALPIKC 

5, 

4) 

E 

O.OOOOE+OO 

BETAIKC 

5 , 

4) 

S 

O.OOOOE+OO 

SIGIK( 

5, 

5) 

0.  1 353E+03 

ALPIKC 

5. 

5) 

E 

0. 1513E-03 

BETAIKC 

5. 

5) 

B 

- .2226E+00 

SIGIK( 

5. 

6) 

0.  1 353E+03 

ALPIKC 

5, 

6) 

B 

0.  1513E-03 

BETAIKC 

5. 

€) 

B 

- . 2226E+00 

SIGIK( 

5. 

7) 

O.OOOOE+OO 

ALPIKC 

5. 

7) 

B 

O.OOOOE+OO 

BETAIKC 

5. 

7) 

B 

O.OOOOE+OO 

SIGIK( 

5. 

8) 

0. 1636E+03 

ALPIKC 

5, 

8) 

E 

0.5675E-03 

BETAIKC 

5. 

8) 

B 

- . 9952E-01 

SIGIK( 

5. 

9) 

O.OOOOE+OO 

ALPIKC 

5, 

9) 

E 

O.OOOOE+OO 

BETAIKC 

5,  9) 

E 

O.OOOOE+OO 

SIGIK( 

5, 10) 

O.OOOOE+OO 

ALPIKC 

5, 

10) 

B 

O.OOOOE+OO 

BETAIKC 

5,  10) 

B 

O.OOOOE+OO 

SIGIK( 

6, 

1) 

b 

0.  1 636E+03 

ALPIKC 

6, 

1) 

E 

0.5675E-03 

BETAIKC 

6, 

1) 

B 

“.9952E-01 

SIGIK( 

6, 

2) 

0.  1 793E+03 

ALPIKC 

6 , 

2) 

E 

0.  1443E-06 

BETAIKC 

6,  2) 

B 

0.37 1 8E+00 

SIGIK( 

6. 

3) 

O.OOOOE+OO 

ALPIKC 

6. 

3) 

E 

O.OOOOE+OO 

BETAIKC 

6,  3) 

= 

O.OOOOE+OO 

SIGIK( 

6, 

4) 

O.OOOOE+OO 

ALPIKC 

6, 

4) 

E 

O.OOOOE+OO 

BETAIKC 

6, 

4) 

B 

O.OOOOE+OO 

SIGIK( 

6, 

5) 

0. 1 353E+03 

ALPIKC 

6. 

5) 

E 

0.  1513E-03 

BETAIKC 

6 , 

5) 

B 

- .2226E+00 

SIGIK( 

6 , 

6) 

0. 1 353E+03 

ALPIKC 

6. 

6) 

E 

0.  1513E-03 

BETAIKC 

6,  6) 

B 

- .222GE+00 

SIGIK( 

6. 

7) 

O.OOOOE+OO 

ALPIKC 

6, 

7) 

B 

O 

O 

+ 

IU 

0 

0 

0 

0 

b 

BETAIKC 

6 , 

7) 

B 

O.OOOOE+OO 

SIGIK(  6,  8)  « O. 1636E+03  ALPIK(  6,  8)  = 0.5675E-03  BETAIK(  6.  8)  * -.9952E-01 
SIGIK(  6.  9)  * O.OOOOE+OO  ALPIK(  6.  9)  = O.OOOOE+OO  BETAIK(  6.  9)  * O.OOOOE+OO 
SI GXK(  6,10)  * O.OOOOE+OO  ALPIK(  6,10)  * O.OOOOE+OO  BETAIK(  6,10)  * O.OOOOE+OO 
SIGI K(  7,  1)  = 0 . 1 636E+03  ALPIK(  7,  1)  = 0.5675E-03  B'ETAIK(  7,  1)  = -.9952E-01 
SIGIK(  7.  2)  * 0 . 1 793E+03  ALPIK(  7,  2)  = 0. 1443E-06  BETAIK(  7.  2)  * 0.3718E+00 
SIGIK ( 7,  3)  = O.OOOOE+OO  ALPIK(  7.  3)  * O.OOOOE+OO  BETAIK(  7.  3)  * O.OOOOE+OO 
SIGIK(  7,  4)  * O.OOOOE+OO  ALPIK(  7.  4)  * O.OOOOE+OO  BETAIK(  7,  4)  * O.OOOOE+OO 
SIGIK(  7.  5)  * O.  1353E+03  ALPIK(  7,  5)  - 0.1513E-03  BETAIK(  7.  5)  = -.2226E+00 
SIGIK(  7,  6)  * O. 1353E+03  ALPIK(  7,  6)  = 0.1513E-03  BETAIK(  7,  6)  = -.2226E+00 
SIGIK(  7,  7)  - O.OOOOE+OO  ALPIK(  7,  7)  = O.OOOOE+OO  BETAIK(  7,  7)  * O.OOOOE+OO 
SI GIK(  7.  8)  = O . 1 636E+03  ALPIK(  7,  8)  = 0.5675E-03  BETAIK(  7,  8)  = -.9952E-01 
SIGIK(  7,  9)  * O.OOOOE+OO  ALPIK(  7,  9)  = O.OOOOE+OO  BETAIK(  7,  9)  = O.OOOOE+OO 
SI GI K(  7,10)  * O.OOOOE+OO  ALPIK(  7,10)  = O.OOOOE+OO  BETAIKC  7,10)  = O.OOOOE+OO 
SIGIK(  8,  1)  * 0 . 1 636E+03  ALPIK(  8,  1)  = 0.5675E-03  BETAI K(  8,  1)  = -.9952E-01 
SIGIK(  8,  2)  = 0.1793E+03  ALPIK(  8,  2)  = 0. 1443E-06  BETAIK(  8,  2)  = 0.3718E+00 
SIGIK(  8,  3)  = O.OOOOE+OO  ALPIK(  8,  3)  = O.OOOOE+OO  BETAIK(  8,  3)  = O.OOOOE+OO 
SIGIK(  8.  4)  * O.OOOOE+OO  ALPIK(  8,  4)  = O.OOOOE+OO  BETAIK(  8,  4)  * O.OOOOE+OO 
SIGIK(  8.  5)  * O . 1 353E+03  ALPIK(  8,  5)  * 0.1513E-03  BETAIK ( 8,  5)  = -.2226E+00 
S I GIK ( 8,  6)  * O . 1 353E+03  ALPIK(  8,  6)  = 0.1513E-03  BETAIK(  8,  6)  * -.2226E+00 
SI GIK(  8,  7)  * O.OOOOE+OO  ALPIK(  8,  7)  * O.OOOOE+OO  BETAIK(  8.  7)  *=  O.OOOOE+OO 
SIGI K(  8,  8)  = 0 . 1 636E+03  ALPIK(  8,  8)  = 0.5675E-03  BETAIK(  8.  8)  * -.9952E-01 
SIGIK(  8,  9)  = O.OOOOE+OO  ALPIK(  8.  9)  = O.OOOOE+OO  BETAIK(  8,  9)  = O.OOOOE+OO 
SIGIK(  8,10)  * O.OOOOE+OO  ALPIK(  8,10)  = O.OOOOE+OO  BETAIK(  8,10)  = O.OOOOE+OO 
SIGIK(  9,  1)  = O. 1636E+03  ALPIK(  9,  1)  = 0.5675E-03  BETAIK(  9,  1)  = -.9952E-01 
SIGIK(  9.  2)  * O. 1793E+03  ALPIK(  9,  2)  = 0.1443E-06  BETAIK(  9,  2)  = 0.3718E+00 
SIGIK(  9,  3)  = O.OOOOE+OO  ALPIK(  9,  3)  * O.OOOOE+OO  BETAIK(  9,  3)  = O.OOOOE+OO 
SIGIK(  9.  4)  = O.OOOOE+OO  ALPIK(  9 , "4 ) * O.OOOOE+OO  BETAIK(  9,  4)  * O.OOOOE+OO 
SIGIK(  9,  5)  = 0 . 1 353E+03  ALPIK(  9.  5)  = 0.1513E-03  BETAIK(  9,  5)  * -.2226E+00 
SIGIK(  9.  6)  = 0 . 1 353E+03  ALPIK(  9,  6)  = 0.1513E-03  BETAIK(  9.  6)  = -.2226E+00 
SIGIK(  9,  7)  = O.OOOOE+OO  ALPIK(  9,  7)  = O.OOOOE+OO  BETAI K(  9,  7)  = O.OOOOE+OO 
SI GIK(  9,  8)  * O . 1 636E+03  ALPIK(  9,  8)  = 0.5675E-03  BETAIK(  9,  8)  = -.9952E-01 
SIGIK(  9,  9)  = O.OOOOE+OO  ALPIK(  9,  9)  = O.OOOOE+OO  BETAIK(  9,  9)  = O.OOOOE+OO 
SIGIK(  9,10)  = O.OOOOE+OO  ALPIK(  9,10)  = O.OOOOE+OO  BETAIK ( 9,10)  = O.OOOOE+OO 
SIGIK(10.  1)  = O. 1636E+03  ALPIK( 10,  1)  = 0.5675E-03  BETAIK( 10.  1)  = -.9952E-01 
SIGIKdO,  2)  = O. 1793E+03  ALPIK(10,  2)  = 0.1443E-06  BETAIK( 10 , 2)  = 0.3718E+00 
SIGIKC10,  3)  = O.OOOOE+OO  ALPIK(10.  3)  = O.OOOOE+OO  BETAIK( 10,  3)  = O.OOOOE+OO 
SIGIK(10,  4)  = O.OOOOE+OO  ALPIK( 10,  4)  = O.OOOOE+OO  BETAIK( 10,  4)  = O.OOOOE+OO 
SIGIKdO.  5)  = 0 . 1 353E+03  ALPIK(10,  5)  = 0.1513E-03  BETAIK( 10,  5)  = -.2226E+00 
SIGIK(10,  6)  = 0 . 1 353E+03  ALPIK(10,  6)  = 0.1513E-03  BETAIK( 10,  6)  = -.2226E+00 
SIGIKdO,  7)  = O.OOOOE+OO  ALPIK( 10 , 7)  = O.OOOOE+OO  BETAIK ( 10,  7)  = O.OOOOE+OO 
SIGIKdO.  6)  = 0.1636E+03  ALPIK(10,  8)  = 0.5675E-03  BETAIK( 10,  8)  = -.9952E-01 
SIGIKdO.  9)  = O.OOOOE+OO  ALPIK(10,  9)  = O.OOOOE+OO  BETAIK ( 1 0 , 9)  = O.OOOOE+OO 


b7Q 


SIGIK(IO.IO)  » 0. OOOOE+OO  ALPIK( 10. 10)  « 0. OOOOE+OO  BETAIK(  10.  10)  - 0. OOOOE+OO 


END  INPUT 


+++  SHOCK  GEOMETRY  +++ 


X 

ZS 

RS 

RC 

COST 

SINT 

0 . OOOOE+OO 

0. OOOOE+OO 

0. OOOOE+OO 

0 . 2300E+03 

0. OOOOE+OO 

0. lOOOE+O 1 

1 

0.  1667E+00 

0. 1554E-03 

0. 1667E+00 

0 . 2300E+03 

0.7246E-03 

0. lOOOE+OI 

2 

0 . 3333E+00 

0 . 3 108E-03 

0 . 3333E+00 

0 . 2300E+03 

0. 1449E-02 

0. lOOOE+OI 

3 

0.5000E+00 

0 . 5599E-03 

0 . 5000E+00 

0 . 2300E+03 

0.2174E-02 

0. 1000E+01 

4 

0. 1000E+01 

0 . 2 178E-02 

0. lOOOE+OI 

0 . 2300E+03 

0.4348E-02 

0. lOOOE+OI 

5 

0. 1 500E+01 

0.4892E-02 

0. 1 5O0E+01 

0 . 2301 E+03 

0.6521E-02 

0. 1000E+01 

6 

0 . 2000E+01 

0.8696E-02 

0 . 2000E+01 

0 . 2301 E+03 

0 . 8694E-02 

0. 1000E+01 

7 

0.2500E+01 

O. 135BE-01 

0 . 2500E+0 1 

0 . 2302E+03 

0. 10B7E-01 

0 . 9999E+00 

8 

0.3000E+01 

0. 1956E-0 1 

0 . 3000E+01 

0 . 2303E+03 

0. 1304E-01 

0 . 9999E+00 

9 

0 . 3500E+0 1 

0.2662E-01 

0.3500E+01 

0 . 2304E+03 

0. 152  IE-01 

0 . 9999E+00 

10 

0.4000E+01 

0 . 3477E-01 

0 . 4000E+01 

0 . 2305E+03 

0. 1738E-01 

0 . 9998E+00 

1 1 

0 . 4500E+01 

0 . 4400E-01 

0 . 4500E+01 

0 . 2307E+03 

0. 1955E-01 

0 . 9998E+00 

12 

0 . 5000E+01 

0.543  IE-01 

0 . 5000E+01 

0 . 230BE+03 

0.2171E-01 

0 . 9998E+00 

13 

0.5500E+01 

0 . 657  IE-01 

0 . 5499E+01 

0 . 23 10E+03 

0.2388E-01 

0 . 9997E+00 

14 

0.6000E+01 

0.7819E-01 

0 . 5999E+01 

0 . 23 1 2E+03 

0 . 2604 E *01 

0 . 9997E+00 

15 

0.6500E+01 

0 . 9 175E-0 1 

0 . 6499E+0 1 

0 . 23 14E+03 

0 . 2B20E-01 

0 . 9996E+00 

16 

0 . 7000E+0 1 

0. 1064E+00 

0 . 6999E+0 1 

0 . 23 16E+03 

0.3036E-01 

0 . 9995E+00 

17 

0.7500E+01 

0. 1221 E+00 

0 . 7499E+0 1 

0. 2318E+03 

0.3252E-01 

0 . 9995E+00 

18 

0.8000E+01 

0. 1389E+00 

0 . 7998E+01 

0 . 232 1 E+03 

0.3467E-01 

0. 9994E+00 

19 

0.8500E+01 

0. 1568E+00 

0.6498E+01 

0 . 2324E+03 

0.3682E-01 

0 . 9993E+00 

20 

0 . 9000E+01 

0. 1 757E+00 

0. 8998E+01 

0 . 2326E+03 

0.3897E-01 

0 . 9992E+00 

21 

0 . 9500E+0 1 

0. 1958E+00 

0 . 9497E+01 

0 . 2329E+03 

0.4112E-01 

0 . 9992E+00 

22 

0. 1000E+02 

0 . 2 165E+00 

0 . 9997E+0 1 

0 . 2333E+03 

0 . 4326E-0 1 

0 . 999 1 E+00 

23 

+++  FREESTREAM  QUANTITIES  +++ 


MUINF  * 

0 . 2885E+02 

RHOINF  * 0.2766E-07  AINF  * 

0 . 2820E+05 

TINF  « 

0. 1971 E+03 

PINF  * 0. 1572E+02  VINF  * 

0 . 89 1 5E+06 

MINF  * 

0.3161 E+02  El INF  * 

0.9781E+12  EINF  * 0.1420E+10' 

EEIINF  * 0 

EVI INF ( 

D * 

0. 3378E+03 

E VI INF ( 

2)  * 

0 . 5740E+05 

EVI INF ( 

3)  * 

0 . OOOOE+OO 

EVI INF ( 

4)  * 

0. OOOOE+OO 

EVI INF ( 

5)  * 

0 . 6999E+04 

EVI INF ( 

6)  * 

0 . 2747E+03 

EVI INF ( 

7)  = 

0. OOOOE+OO 

EVI INF ( 

8)  * 

0. 1 1B4E+04 

EVI INF ( 

9)  * 

0. OOOOE+OO 

EVI INF (10)  = 

0. OOOOE+OO 

+++  QUANTITIES  BEHIND  SHOCK  +++ 


TS 

. 3040E+05 
. 3040E+05 
. 3040E+C5 
.3040E+05 
. 3040E+05 
. 3040E+05 
.3040E+05 
.3040E+05 
.3039E+05 
. 3039E+05 


ES 

. 3054  E+ 1 2 
. 3054E+ 1 2 
.3054E+12 
. 3054  E + 1 2 
. 3054E  + 1 2 
.3054E+12 
. 3054E+  1 2 
. 3054E  + 1 2 
. 3054E  + 1 2 
.3054E+12 


PS 

. 1923E+05 
. 1923E+05 
. 1923E+05 
. 1 923E+05 
. 1923E+05 
. 1923E+05 
. 1923E+05 
. 1923E+05 
. 1923E+05 
. 1923E+05 


RHOS 

. 2 195E-06 
. 2 1 95E-06 
. 2 195E-06 
. 2 1 95E-06 
.2195E-06 
. 2195E-06 
. 2 195E-06 
. 2 195E-06 
.2195E-06 
.2195E-0S 


US 

. 0000 E +00 
.6460E+03 
. 1292E+04 
. 1938E+04 
. 3876E+04 
. 58 1 3 E+04 
.7751E+04 
.9687E+04 
. 1 162E+05 
. 1356E+05 


PSIS 

. OOOOE+OO 
.3425E-03 
. 1370E-02 
. 3083  E -02 
. 1233E-01 
.2774E-01 
. 4932E-0 1 
. 7707E-01 
. 1110E+00 
. 1 5 10E+00 


HS 

.3931E+12 
. 393 1 E+ 1 2 
. 393 1 E+  12 
. 3921 E+  12 
. 393 1 E+  1 2 
. 3930E  + 1 2 
. 3930E  + 1 2 
. 3930E  + 1 2 
. 3930E  + 1 2 
. 3930E  + 1 2 


. 3039E+05 

. 3054 E+ 12 

. 1923E+05 

. 2 195E-08 

. 1549E+05 

. 1973E+00 

. 3929E+ 1 2 

. 3039E+05 

. 3053E+ 1 2 

. 1922E+05 

. 2 195E-06 

. 1742E+05 

. 2497E+00 

. 3929E+ 1 2 

. 3039E+05 

.3053 E+12 

. 1922E+05 

. 2 195E-06 

. 1936E+05 

. 3082E+00 

. 3929E+ 12 

. 3038E+05 

.3053E+12 

. 1922E+05 

. 2 195E-06 

. 2 129E+05 

. 3729E+00 

. 3928E+ 1 2 

. 3038E+05 

.3052E+12 

. 1 922E+05 

. 2 195E-06 

.2321E+05 

. 4438E+00 

.3928E+12 

. 303BE+05 

. 3052E+ 1 2 

. 1 922E+05 

.2195E-06 

. 25 14E+05 

.5209E+00 

. 3928E+ 1 2 

. 3037E+05 

. 3052E+ 1 2 

. 1921E+05 

.2195E-06 

.2707E+05 

.6O40E+O0 

. 3927E+ 12 

.3037E+05 

. 305 1 E+ 12 

. 1921E+05 

. 2 195E-06 

. 2899E+05 

.6934E+00 

. 3926E+ 1 2 

.3037E+05 

. 305 1 E+ 1 2 

. 1921E+05  • 

. 2 195E-06 

.309 IE +05 

.7889E+00 

. 3926E+ 1 2 

.3036E+05 

. 3050E+ 1 2 

. 1920E+05 

.2195E-06 

. 3283E+05 

.8905E+O0 

. 3925E+ 1 2 

. 3036E+05 

. 3050E+ 1 2 

. 1920E+05 

. 2 1 95E-06 

. 3474E+05 

. 9983E+00 

. 3925E+ 1 2 

. 3035E+05 

. 3049E+ 1 2 

. 1920E+05 

. 2 195E-06 

. 3666E+05 

. 1 1 12E+01 

.3924E+12 

.3035E+05 

XXXXX  ITK 
NO.  OF  VIB. 

. 3049E+ 1 2 

« 18 
LEVELS  TO 

. 1 9 19E+05  .2195E-06 

NXPST  « 20  XXXXX 

DISSOCIATION 

. 3857E+05 

. 1232E+01 

.3923E+12 

NI( 

D 

34 

NI( 

2) 

27 

NI( 

3) 

0 
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4) 

0 
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5) 

29 
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6) 

38 
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7) 

0 
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8) 

33 
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9) 

0 

NI( 10) 

0 

IZTERM  * 23 


COUPLED  VIBRATION-DISSOCIATION  MODELS 


TYPE  NO. 

VIB.  EOUIL.  * 0 

CVD  1 

CVDV  2 

CVDV-Pref erent ial  3 

PARK  4 


SHOCK  JUMP  CONDITION  MODELS 


TYPE  NO. 

CHEMISTRY  FROZEN  1 

N2  FROZEN,  02  DISS.  2 

N2  AND  02  DISS.  3 


MILLIKAN  AND  WHITE  DATA  FOR  N2  AND  N2+  WAS  SELECTED 


xxxxxxxxxxxxxxxx 


PSI 


2 

H 

X 

H 

SHOCK 

J 

COND . = 1 

CVD  MODEL  * 

1667D+00 

H = . 393 1D+ 1 2 

MU 

. 2885E+02  P * . 

. 1923E+05 

RHO  « .2195E< 

6460E+03 

T = . 3040E+05 

E 

■ . 

3054E+ 1 2 CIT  = 
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-03 

SUMCI  « . 100( 

CI( 

1) 

= 

0 . 7680D+00 

CM( 

1) 

= 

0 . 7908E+00 

EVI  ( 

D 

= 0 . 3378D+03 

CI( 

2) 

= 

0.2320D+00 

CM( 

2) 

= 

0 . 2092E+00 

EVI  ( 

2) 

= 0 . 5740D+05 

CI( 

3) 

= 

0 . OOOOD+OO 

CM( 

3) 
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EVI  ( 

3) 

= 0. OOOOD+OO 

CI( 

4) 

= 

0 . OOOOD+OO 

CM( 

4) 

= 

0 . 0000 E +00 

EVI  ( 

4) 

= 0. OOOOD+OO 
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5) 

= 

0 . OOOOD+OO 

CM( 

5) 

= 

0 . OOOOE+OO 

EVI  ( 

5) 

= 0 . 6999D+04 

CI( 

6) 

= 

0 . OOOOD+OO 

CM( 

6) 

O . OOOOE+OO 

EVI  ( 

6) 

= 0 . 2747D+03 

CI  ( 

7) 

= 

0 . OOOOD+OO 

CM( 

7) 

0. OOOOE+OO 

EVI  ( 

7) 

= 0 . OOOOD+OO 

CI  ( 

8) 

= 

0 . OOOOD+OO 

CM( 

8) 

= 

0. OOOOE+OO 

EVI  ( 

6) 

= 0. 1 184D+04 

CI( 

9) 

* 

0. 00000+00 

CM( 

9) 

X 

0. OOOOE+OO 

EVI  ( 

9) 

■ 0 . OOOOD+OO 

CI( 10) 

• 

0 . 0000D+00 

CM( 10) 

X 

0. OOOOE+OO 

EVI( 10) 

- 0.00000+00 

TVI  ( 

D 

* 

0. 1971E+03 

TVI  ( 

2) 

x 

0. 1971E+03 

TVI  ( 

3) 

m 

0 . OOOOE+OO 

TVI  ( 

4) 

m 

0. OOOOE+OO 

TVI  ( 

5) 

• 

0. 1971E+03 

TVI  ( 

6) 

* 

0. 197 1E+03 

TVI  ( 

7) 

x 

0. OOOOE+OO 

TVI  ( 

8) 

x 

0. 1971E+03 

TVI  ( 

9) 

x 

0. OOOOE+OO 
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m 

0. OOOOE+OO 

TE  1 * 

0.1971E+03  ITRTE* 

o 

c 
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o 

OOOE+OO 

PSI 

X 

2 
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SHOCK 

J 

COND . « 1 

CVD  MODEL  « 

4 
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. 2 1 160+00 

H * .3931D+12 

MU 

X 

. 1826E+02  P * 

. 1923E+05 

RHO  * . 2748E- 

-06 

u * 

. 1042E+04 

T « . 1537E+05 

E 

X 

3231E+12  CIT  ■ 

.9766E- 

-03 

SUMCI  * . 1000E+01 

CI( 

D 

K 

0 . 4049D+00 

CM( 

1) 

X 

0. 2640E+00 

EVI  ( 

D 

* 0.2333D+11 

CI( 

2) 

x 

0 . 4839D-03 

CM( 

2) 

X 

0. 2762E-03 

EVI  ( 

2) 

« 0.36490+11 

CI( 

3) 

x 

0 . 3542D+00 

CMC 

3) 

X 

0.46 1 7E+00 

EVI  ( 

3) 

* 0 . 00000+00 

CI( 

4) 

m 

0 . 2268D+00 

CM( 

4) 

X 

0. 2589E+00 

EVI  ( 

4) 

* 0 . OOOOD+OO 

CI( 

5) 

x 

0. 683  ID-02 

CM( 

5) 

X 

0.41 57E-02 

EVI  ( 

5) 

* 0 . 3920D+ 1 1 

CI( 

6) 

X 

0. 1 520D-02 

CM( 

6) 

X 

0.9251E-03 

EVI  ( 

6) 

* 0.38270+11 

CI( 

7) 

m 

0. 1642D-06 

CM( 

7) 

X 

0.5467E-02 

EVK 

7) 

* 0. OOOOD+OO 

CI( 

8) 

w 

0. 34020-02 

CMC 

8) 

X 

0 . 22 18E-02 

EVI( 

B) 

* 0 . 42350+ 1 1 

CI( 

9) 

x 

0.  158BD-02 

CMC 

9) 

X 

0 . 2070E-02 

EVI  ( 

9) 

* 0. OOOOD+OO 

CI( 10) 

X 

0.22320-03 

CM( 10) 

X 

0 . 2548E-03 

EVI (10) 

* 0. OOOOD+OO 

TVI  ( 

1) 

x 

0 . 9457E+04 

TVI  ( 

2) 

x 

0. 15 1 5E+05 

TVI  ( 

3) 

x 

0. OOOOE+OO 

TVI  ( 

4) 

X 

0. OOOOE+OO 

TVI  ( 

5) 

X 

0. 1 548E+05 

TVI  ( 

6) 

x 

0. 1546E+05 

TVI  ( 

7) 

X 

0. OOOOE+OO 

TVI  ( 

8) 

X 

0. 1 578E+05 

TVI  ( 

9) 

x 

0. OOOOE+OO 

TVI ( 10) 

X 

0. OOOOE+OO 

TE 

« 0.1154E+05  ITRTE- 

4 W 1 * 0 

198E+28 

PSI 

X 

2 

o 

It 

X 

H 

SHOCK 

J 

COND.  * 1 

CVD  MODEL  = 

4 

X * 

. 3034D+00 

H « .39310+12 

MU 

X 

1 683E+02  P = 

. 1 923E+05 

RHO  = . 3 1 93E- 

-06 

u * 

. 1068E+04 

T * . 1220E+05 

E 

* . 3328E+ 1 2 CIT  = 

. 1953E- 

-02 

SUMCI  * . 1000E+01 

CI( 

1) 

X 

0 . 2824D+00 

CM( 

D 

X 

0. 1 697E+00 

EVI  ( 

1) 

= 0.2061D+11 

Cl  C 

2) 

X 

0.  15660-03 

CM( 

2) 

X 

0.8238E-04 

EVI  ( 

2) 

* 0.28720+11 

CI( 

3) 

X 

0 . 4789D+00 

CM( 

3) 

X 

0 . 5755E+00 

EVI( 

3) 

= 0. OOOOD+OO 

CI( 

4) 

E 

0 . 2280D+00 
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4) 

X 

0 . 2399E+00 

EVI  ( 

4) 

* 0. OOOOD+OO 
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5) 

X 

0 . 4248D-02 

CM( 

5) 

X 

0 . 2383E-02 

EVI( 

5) 

= 0 . 3023D+ 1 1 

CI( 

6) 

X 

0 . 5445D-03 

CM( 

6) 

X 

0 . 3055E-03 

EVI  ( 

6) 

* 0 . 2935D+ 1 1 

CI( 

7) 

X 

0.2012D-06 

CM( 

7) 

X 

0.6175E-02 

EVI( 

7) 

= 0. OOOOD+OO 

CI( 

8) 

X 

0.11910-02 

CM( 

8) 

X 

0.71 58E-03 

EVI( 

8) 

= 0 . 3230D+ 1 1 

CI( 

9) 

X 

0. 32200-02 

CM( 

9) 

X 

0 . 3B70E-02 

EVI( 

9) 

= 0 . OOOOD+OO 

CI( 10) 

X 

0.  12200-02 

CM ( 10) 

X 

0. 1284E-02 

EVI (10) 

* 0. OOOOD+OO 

TVI  ( 

D 

X 

0 . 8528E+04 

»> 

TVI  ( 

2) 

X 

0. 1215E+05 

TVI  ( 

3) 

X 

0. OOOOE+OO 

TVI  ( 

4) 

X 

0. OOOOE+OO 

TVI  ( 

5) 

X 

0. 1223E+05 

TVI  ( 

6) 

X 

0.  1222E+05 

TVI  ( 

7) 

X 

0. OOOOE+OO 

TVI  ( 

8) 

X 

0. 1 238E+05 

TVI  ( 

9) 

X 

0. OOOOE+OO 

TVI ( 10) 

s 

0. OOOOE+OO 

TE  1 

= 0. 1082E+05  ITRTE- 

o 

II 

134E+28 

PSI 

- 

2 

IX  = 151 

SHOCK 

J 

COND . = 1 

CVD  MODEL  = 

4 

. 393 1 D+ 1 2 MU  « . 1632E+02 


C7J 


x 


. 40 10D+00  H 


P = . 1923E+05  RHO 


.3440E-06 


U - . 1 1 13E+04 


T - . 1097E+05  E * .3372E+12  CIT  « . 1953E-02 


SUMCI  « . 1000E+01 


P SI 

X « 

u * 


PSI 
X «= 

u = 


CI( 

D 

■ 

0.23330+00  CM(  1) 

m 

0. 1359E+00 

EVI( 

1) 

0.2090D+1 1 

CI( 

2) 

* 

0.10170-03  CMC  2) 

m 

0. 5 189E-04 

EVI  ( 

2) 

0.2561D+1 1 

CI( 

3) 

m 

0. 52B4D+00  CM(  3) 

m 

0.61 55E+00 

EVI  ( 

3) 

0. OOOOD+OO 

CI( 

4) 

m 

0. 2278D+00  CMC  4) 

m 

0 . 2323E+00 

EVI  ( 

4) 

0 . OOOOD+OO 

CI( 

5) 

m 

0. 3675D-02  CMC  5) 

m 

0. 1999E-02 

EVI  ( 

5) 

0.2682D+1 1 

CI( 

6) 

m 

0.28220-03  CM(  6) 

m 

0. 1535E-03 

EVI  ( 

6) 

0. 2595D+ 1 1 

CI( 

7) 

m 

0.23880-06  CM(  7) 

m 

0 . 7 103E-02 

EVI  ( 

7) 

0. OOOOD+OO 

CI( 

8) 

u 

0 . 5677D-03  CM(  8) 

m 

0.3307E-03 

EVI  ( 

8) 

0 . 2853D+ 1 1 

CI( 

9) 

m 

0. 39400-02  CMC  9) 

w 

0. 4590E-02 

EVI  ( 

9) 

0. OOOOD+OO 

CI( 

10) 

■ 

0. 19890-02  CM( 10) 

m 

0.2029E-02 

EVI ( 10) 

0. OOOOD+OO 

TVI  ( 

D 

0.8629E+04 

TVI  ( 

2) 

0. 1095E+05 

TVI  ( 

3) 

0 . OOOOE+OO 

TVI  ( 

4) 

0 . OOOOE+OO 

TVI  ( 

5) 

0. 1099E+05 

TVI  ( 

6) 

0. 1099E+05 

TVI  ( 

7) 

0. OOOOE+OO 

TVI  ( 

8) 

0. 1 1 10E+05 

TVI  ( 

9) 

0. OOOOE+OO 

TVI  ( 

10) 

0. OOOOE+OO  TE 1*  0. 1029E+05  ITRTE*  4 

W1«  0 

958E+27 

m 

2 

IX  » 201  SHOCK 

J 

COND . ■ 1 

CVD  MODEL  - 4 

. 4987D+00 

H « . 393 1D+ 1 2 MU  » 

1604E+02  P * . 

1923E+05 

RHO  « . 3601 E-06 

. 1 205E+04 

T - . 1030E+05  E * . 3397E+ 12  CIT  * 

. 1953E- 

-02 

SUMCI  « , 1000E+01 

Cl  ( 

1) 

X 

0. 20540+00  CM(  1) 

x 

0.  1 176E+00 

EVI  ( 

D 

= 

0.2102D+1 1 

CI( 

2) 

c 

0.7790D-04  CM(  2) 

X 

0. 3904 E -04 

EVI  ( 

2) 

0.2389D+1 1 

CI( 

3) 

c 

0. 55620+00  CM(  3) 

X 

0 . 6369E+00 

EVI  ( 

3) 

* 

0 . OOOOD+OO 

CI( 

4) 

c 

0. 22750+00  CMC  4) 

s 

0 . 2280E+00 

EVI  ( 

4) 

c 

0 . OOOOD+OO 

CI( 

5) 

= 

0.33410-02  CM(  5) 

X 

0.  1 786E-02 

EVI  ( 

5) 

= 

0.2496D+1 1 

CI( 

6) 

c 

0.18480-03  CM(  6) 

X 

0.9880E-04 

EVI  ( 

6) 

X 

0.2410D+11 

CI( 

7) 

s 

0.26740-06  CM(  7) 

u 

0.7816E-02 

EVI  ( 

7) 

X 

0. OOOOD+OO 

CI( 

8) 

c 

0.3429D-03  CM(  8) 

X 

0. 1963E-03 

EVI  ( 

8) 

X 

0.2647D+1 1 

CI( 

9) 

s 

0.43440-02  CMC  9) 

X 

0 . 4974E-02 

EVI  ( 

9) 

= 

0 . OOOOD+OO 

CI( 

10) 

X 

0.25410-02  CM( 10) 

* 

0 . 2547E-02 

EVI( 10) 

X 

0 . OOOOD+OO 

TVI  ( 

1) 

IS 

0 . 8670E+04 

TVI  ( 

2) 

X 

0. 1029E+05 

TVI  ( 

3) 

s 

0. OOOOE+OO 

TVI  ( 

4) 

c 

O. OOOOE+OO 

TVI  ( 

5) 

X 

0. 1032E+05 

TVI  ( 

6) 

c 

0.  1031E+05 

TVI  ( 

7) 

s 

0. OOOOE+OO 

TVI  ( 

8) 

x 

0. 1040E+05 

TVI  ( 

9) 

= 

0. OOOOE+OO 

TVI ( 10) 

X 

0. OOOOE+OO  TE 1 = 0 . 9903E+04  ITRTE*  3 

W 1 = 0 

674E+27 

2 

IX  * 202  SHOCK 

J 

COND . * 1 

CVD  MODEL  * 4 

. 5007D+00  H * . 393 1D+ 12  MU  * . 1604 E +02  P 


. 1 923E+05 


RHO 


. 3604E-06 


, 1207E+04  T = . 1029E+05  E = .3397E+12  CIT  * . 1953E-02  SUMCI 


, 1 000E+01 


ciC 

D 

s 

0 . 20500+00 

CM( 

O 

X 

0. 1 173E+00 

EVIC 

1) 

X 

0.2 102D+  1 1 

ciC 

2) 

= 

0.7754D-O4 

CMC 

2) 

* 

0.3886E-04 

EVI( 

2) 

* 

0 . 2386D+  1 1 

ci( 

3) 

s 

0 . 5567D+O0 

CM( 

3)' 

X 

0 . 6372E+00 

EVI( 

3) 

X 

0 . OOOOD+OO 

ciC 

4) 

tr 

0 . 2275D+00 

CM( 

4) 

X 

0 . 2280E+00 

EVI( 

4) 

X 

0. OOOOD+OO 

ci( 

5) 

= 

0 . 3335D-02 

CMC 

5) 

X 

0. 1782E-02 

EVI  ( 

5) 

= 

0.2493D+1 1 

ci( 

6) 

X 

0. 1836D-03 

CM( 

6) 

s 

0.981 OE-04 

EVI  ( 

6) 

s 

0.2407D+1 1 

ci( 

7) 

s 

0 . 2678D-06 

CM( 

7) 

X 

0 . 7B28E-02 

EVI  ( 

7) 

= 

0. OOOOD+OO 

ci( 

8) 

= 

0.3401D-03 

CMC 

8) 

X 

0. 1947E-03 

EVI( 

8) 

s 

0 . 2643D+ 1 1 

ci( 

9) 

= 

0 . 4350D-02 

CM( 

9) 

= 

0 . 4980E-02 

EVI( 

9) 

= 

0 . OOOOD+OO 

ci( 

10) 

~ 

0 . 2550D-02 

CM( 10) 

s 

0 . 2556E-02 

EVI( 10) 

- 

0. OOOOD+OO 

TVI  ( 

D 

= 

0.8670E+04 

TVI  ( 

2) 

= 

0. 1028E+05 

TVI  ( 

3) 
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0. OOOOE+OO 

TVI  ( 
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6) 
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B 
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B 
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B 
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CM( 10) 

a 
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H = . 393 1D+ 1 2 

MU 

8 

1815E+02  P = . 

1923E+05 
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0.8786E+04 
0. OOOOE+OO 
0.8821E+04 
0. OOOOE+OO 

0. OOOOE+OO  TE 1 - 0.8725E+04  ITRTE  = 3 W1=  0.154E+27 


xxxxxxxxxxxxxxxx 


b fl 


X - . 1000D+02 

H - .39240+12 

MU 

■ 

. 1900E+02  P - . 

1919E+05 

RHO  - .2605E-06 

U « . 3580E+05 

T « . 1683E+05 

E 

B 

3188E+12  CIT  « 

. 3125E 

>01 

SUMCI  « . 1000E+01 

CI(  1) 

m 

0.46150+00 

CM( 

1) 

m 

0 . 3 130E+00 

EVI  ( 

1) 

« 0 . 2556D+ 1 1 

Cl  ( 2) 

u 

0.81 190-03 

CM( 

2) 

B 

0.482  IE-03 

EVI  ( 

2) 

« 0 . 397BD+ 1 1 

Cl  ( 3) 

m 

0.29670+00 

CM( 

3) 

B 

0. 4025E+00 

EVI  ( 

3) 

« 0. OOOOD+OO 

CI(  4) 

m 

0.22590+00 

CM( 

4) 

B 

0 . 2682E+00 

EVI  ( 

4) 

« 0. OOOOD+OO 

CI(  5) 

m 

0.8527D-02 

CM( 

5) 

8 

0 . 5399E-02 

EVI  ( 

5) 

« 0 . 4339D+ 1 1 

CI(  6) 

m 

0. 1492D-02 

CM( 

6) 

8 

0.9448E-03 

E VI  ( 

6) 

* 0.4242D+11 

CI(  7) 

* 

0. 1502D-06 

CM( 

7) 

B 

0.5201E-02 

EVI( 

7) 

■ 0. OOOOD+OO 

CI(  8) 

m 

0. 41730-02 

CM( 

8) 

B 

0.2830E-02 

EVI  ( 

8) 

- 0 . 4708D+ 1 1 

CI(  9) 

B 

0. 101  ID-02 

CM( 

9) 

B 

0. 1371E-02 

EVI  ( 

9) 

« 0. OOOOD+OO 

CI( 10) 

b 

0.46160-04 

CM ( 10) 

B 

0.5481E-04 

EVI( 10) 

« 0. OOOOD+OO 

TVI(  1) 

m 

0. 1022E+05 

TVI ( 2) 

m 

0. 1 642E+05 

TVI(  3) 

m 

0 . OOOOE+OO 

TVI ( 4) 

c 

0 . OOOOE+OO 

TVI ( 5) 

IB 

0. 1 699E+05 

TVI ( 6) 

b 

0. 1 696E+05 

TVI ( 7) 

m 

0. OOOOE+OO 

TVI ( 8) 

m 

0. 1 738E+05 

TVI ( 9) 

b 

0. OOOOE+OO 

TVI( 10) 

w 

0. OOOOE+OO  TE 1 * 0.11 38E+05  ITRTE«  5 

W 1 * 0 

. 6 1 5E  + 28 

XXXXXXXXXXXXXXXX 

PSI  « 22 

IX  * 1 

SHOCK 

J 

COND . - 1 

CVD  MODEL  - 4 

X * .95000+01 

H « . 3924D+ 1 2 

MU 

B 

2885E+02  P « . 

1920E+05 

RHO  * .2195E-06 

U « . 3666E+05 

T « . 3035E+05 

E 

. 3049E+ 1 2 CIT  « 

. 1221E 

“03 

SUMCI  « . 1000E+0 1 

CI(  1) 

s 

0 . 768CD+00 

CM  ( 

1) 

s 

0 . 7908E+00 

EVI  ( 

1) 

* 0 . 3378D+03 

Cl  c 2) 

= 

0.23200+00 

CM  ( 

2) 

E 

0. 2092E+00 

EVI  ( 

2) 

= 0.5740D+05 

CI(  3) 

s 

0 . OOOOD+OO 

CM  ( 

3) 

S 

0. OOOOE+OO 

EVI  ( 

3) 

* 0 . OOOOD+OO 

CI(  4) 

= 

0 . 00000+00 

CM  ( 

4) 

S 

0. OOOOE+OO 

EVI  ( 

4) 

« 0 . OOOOD+OO 

CI(  5) 

= 

0. OOOOD+OO 

CM( 

5) 

S 

0. OOOOE+OO 

EVI  ( 

5) 

0 . 6999D+04 

CI(  6) 

E 

0. OOOOD+OO 

CM( 

6) 

E 

0. OOOOE+OO 

E VI  ( 

6) 

= 0 . 2747D+03 

CI(  7) 

E 

0.00000+00 

CM( 

7) 

S 

0. OOOOE+OO 

EVI  ( 

7) 

« 0. OOOOD+OO 

Cl  C 8) 

S 

0. OOOOD+OO 

CM( 

8) 

E 

0. OOOOE+OO 

EVI  ( 

8) 

* 0.11 84D+04 

Cl  C 9) 

s 

0 . OOOOD+OO 

CM( 

9) 

B 

0. OOOOE+OO 

EVI  ( 

9) 

* 0 . OOOOD+OO 

CI( 10) 

S 

0 . OOOOD+OO 

CM( 10) 

E 

0. OOOOE+OO 

EVI( 10) 

* 0 . OOOOD+OO 

TVI ( 1) 

E 

0. 1971E+03 

TVI ( 2) 

0. 1971E+03 

TVI ( 3) 

0.  OOOOE+OO 

TVI ( 4) 

0. OOOOE+OO 

TVI ( 5) 

0.  1971E+03 

TVI ( 6) 

0.  1971E+03 

TVI ( 7) 

0. OOOOE+OO 

TVI ( 6) 

S 

0.  1971E+03 

TVI ( 9) 

E 

0. OOOOE+OO 

TVI(IO)  « 0. OOOOE+OO  TE 1 * 0.1971E+03  I TRTE=  5 W1«  0.615E+2B 


BEGIN  PHYSICAL  SPACE  CALCULATIONS  KSTAG  « 209 

PS I * 0 . 00000 E+ 00 


X * 

0 . 500000E+00 

R * 

0 . 466921 E+00 

Y = 

0. 1 52 165E+02 

PSI 

X * 

« 0.30828E-02 

0 . 500000E+00 

R = 

0 . 500000E+00 

Y = 

0 . OOOOOOE+OO 

PS I = 0 . OOOOOE+OO 

X = 0.100000E+01 

PSI  = 0 . 30828  E -02 

X = 0. 100000E+01 

PSI  = 0 . 1 233 1 E “O 1 

X = 0.100000E+01 


R = 0 . 935523E+00 
R = 0 . 953088  E+00 
R = 0 . 1 00052E+01 


Y = 0. 1 48298E+02 

Y = 0. 1 07896E+02 

Y s -0.1 19472E+00 


Z = 0. 1 52 1 70E+02 
Z = 0.559944E-03 

Z c O. 148318E+02 
Z = 0. 1 079 1 7E+02 
Z = -0. 1 17292E+00 


X « 

0 . 750000E  +0 1 

R 

W 

0.7121 56E+01 

Y - 

0. 1 15977E+02 

2 * 

0. 1 171 37E+02 

PSI 

X » 

« 0. 1 5 105 E +00 

0 . 750000E+01 

R 

m 

0.71 5026E+01 

Y « 

0. 107 152E+02 

Z - 

0. 1083 16E+02 

PSI 

X « 

« 0. 19728E+00 

0. 750000E+01 

R 

n 

0.71821 5 E+01 

Y - 

0 . 97344 1 E+01 

2 - 

0 . 985 1 38E+01 

PSI 

X « 

« 0 . 24968E+00 

0.750000E+01 

R 

m 

0.721 706E+01 

Y « 

0.866062E+01 

2 « 

0.877815E+01 

PSI 

X « 

* 0.30823E+00 

0 . 750000E+0 1 

R 

m 

0.725492E+01 

Y * 

0 . 749644  E+0 1 

2 * 

0.761459E+01 

PSI 

X - 

« 0.37295E+00 

0.750000E+01 

R 

w 

0.729573E+01 

Y - 

0.624120E+01 

2 * 

0 . 636001 E+01 

PSI 
X * 

» 0 . 44382E+00 

0.750000E+01 

R 

w 

0.733970E+01 

Y « 

0.488914E+01 

2 « 

0.500867E+01 

PSI 

X * 

- 0 . 52086E+00 

0.750000E+01 

R 

m 

0 . 738729E+0 1 

Y - 

0 . 34254 1 E+0 1 

2 « 

0 . 35457 1 E+0 1 

PSI 

X * 

« 0 . 60404E+00 

0.750000E+01 

R 

M 

0.743965E+01 

Y - 

0. 181 530E+01 

.2  * 

0. 1 93645E+01 

PSI 

X « 

• 0 . 69339E+00 

0.750000E+01 

R 

m 

0.749868E+01 

Y - 

0.721 238E -04 

2 « 

0. 1 22 182E+00 

PS I * 0 . OOOOOE+OO 


X = 

0 . 800000E+01 

R 

= 

0. 750273E+01 

Y 

= 

0. 1 42962E+02 

Z 

- 

0. 144265E+02 

PSI 
X * 

« 0 . 30828E-02 

0.800000E+01 

R 

s 

0 . 75O523E+0 1 

Y 

E 

0. 142242E+02 

2 

= 

0. 143546E+02 

PSI 
X * 

* 0. 12331E-01 

0 . 800000E+01 

R 

s 

0.751266E+01 

Y 

E 

0. 140098E+02 

2 

s 

0. 141 403E+02 

PSI 
X * 

* 0.27745E-01 

0 . 800000E+0 1 

R 

E 

0.752478E+01 

Y 

E 

0. 1 36602E+02 

2 

— 

0. 1 37909E+02 

PSI 

X « 

- 0.49324E-01 

0 . 800000E+01 

R 

E 

0. 754 124E+01 

Y 

S 

0. 1 3 1 857E+02 

Z 

X 

0. 1331 67E+02 

PSI 
X * 

* 0.77067E-01 

0 . B00000E+0 1 

R 

E 

0. 756 165E+01 

Y 

E 

0. 1 25970E+02 

Z 

- 

0. 127283E+02 

PSI 
X * 

= 0. 1 1097E+00 

0.800000E+01 

R 

E 

0 . 758567E+0 1 

Y 

S 

0. 1 1 9042  E+02 

2 

E 

0. 1 20359E+02 

PSI 

X « 

* 0. 151 05E+00 

0.800000E+01 

R 

E 

0.761 300E+01 

Y 

E 

0. 1 1 1 157E+02 

Z 

= 

0. 1 12479E+02 

PSI 
X = 

= 0. 19728E+00 

0 . 800000E+0 1 

R 

E 

0.764342E+01 

Y 

E 

0. 102383E+02 

2 

s 

0. 10371 1E+02 

PSI 
X = 

* 0 . 24968E+00 

0.800000E+01 

R 

S 

0 . 767675E+0 1 

Y 

S 

0 . 92772 1 E+0 1 

Z 

X 

0 . 94 1054E+01 

PSI 
X = 

= 0.30823E+00 

0 . 800000E  +0 1 

R 

S 

0. 77 1286E+01 

Y 

E 

0 . 823566E+0 1 

2 

s 

0 . 836962E+01 

►-#  u 

l/) 

a.  x 

= 0.37295E+00 

0 . 800000E+01 

R 

S 

0. 775 172E+01 

Y 

S 

0.71 1489E+01 

Z 

X 

0.724952E+01 

PSI 
X = 

* 0.44382E+00 

0.800000E+01 

R 

E 

0 . 779338E+01 

Y 

E 

0.5913 1 6E+0 1 

2 

* 

0.604851 E+01 

PSI 
X = 

*=  0.52086E+00 

0 . 800000E+0 1 

R 

S 

0 . 783807E+0 1 

Y 

S 

0 . 4624 1 7E+0 1 

2 

s 

0 . 476030E+0 1 

PSI 
X = 

= 0.60404E+00 

0.800000E+01 

R 

S 

0.788629E+01 

Y 

X 

0.323339E+01 

2 

= 

0 . 337035E+01 

PSI 
X = 

= 0.69339E+00 

0 . 800000E+0 1 

R 

_ 

0. 7939 1 5E+01 

Y 

_ 

0. 170879E+01 

2 

_ 

0. 1 84667E+01 

P SI  * 0.78888E+00 

X - 0.800000E+01  R * 0.799839E+01  Y - 0.377804E-04  Z * 0.  138945E+00 


PSI  * 0 .OOOOOE+OO 

X « 0 . B50000E+01 

PSI  « 0.30828E-02 

X « 0. 850000E+01 

PSI  « 0 . 1233 1 E “01 

X ■ 0.850000E+01 

PSI  ■ 0.27745E-01 

X « 0 . 850000E+01 

PSI  » O. 49324E-01 
X - 0 . 850000E+01 

PSI  « 0.77067E-01 

X * 0. 850000E+01 

PSI  - 0.1 1097E+00 

X * 0 . 850000E+01 

PSI  * 0. 15105E+00 

X » 0 . 850000E+01 

PSI  * 0.19728E+00 

X * 0.850000E+01 

PSI  * 0.24968E+00 

X * 0.85Q000E+01 

PSI  * 0.30823E+0C 

X « 0.850000E+01 

PSI  = 0.37295E+00 

X « 0.850C00E+01 

PSI  * 0 . 44382E+00 

X * 0.850000E+01 

PSI  = 0.52086E+00 

X • 0.850000E+01 

PSI  « 0.60404E+00 

X * 0.850000E+01 

PSI  = 0 . 69339E+00 

X • 0 . 850000E+01 

PSI  * 0 . 7B8BBE+00 

X * 0.850000E+01 

PSI  * 0.89053E+00 

X * 0.850000E+01 


PSI  = 0. OOOOOE+OO 

X * 0 . 900000E+01 

PSI  = 0.30828E-02 

X = 0 . 900000E+0 1 

PSI  ■ 0.12331E-01 

X = 0. 900000E+01 

PSI  * 0.27745E-01 

X = 0 . 900000E+0 1 

PSI  *=  0.49324E-01 

X = 0 . 900000E+0 1 

PSI  = 0.77067E-01 

X = 0 . 900000E+0 1 


R » 0 . 797 1 49E+01 
R * 0 . 797383E+0 1 
R * O. 798084E+0 1 
R « 0. 799230E+01 
R « 0.800789E+01 
R * 0. 802730E+0 1 
R « 0 . 80501 9E+01 
R * 0. B07629E+01 
R * 0. 8 10537E+01 
R * 0 . 8 1 3726E+01 
R * 0.817 182E+01 
R * 0 . B20898E+01 
R * 0 . 824873E+0 1 
R * 0. 829 1 16E+01 
R * 0 . 83365 1 E+01 
R * 0 . 838530E+01 
R = 0 . 8438G2E+01 
R * 0 . 849808E+0 1 

R = 0 . 844020E+01 
R = 0 . 844242E+01 
R * 0 . 844904 E+0 1 
R * 0 . 84 5990E+0 1 
R = 0 . 847473E+0 1 
R = 0.849321 E+0 1 


Y - 0. 143007E+02  Z - 

Y - 0. 142369E+02  Z * 

Y - 0.140466E+02  Z ■ 

Y * 0. 137355E+02  Z - 

Y * 0. 1331 20E+02  Z « 

Y » 0. 127851E+02  Z - 

Y - 0.12 1634E+02  Z - 

Y « 0.1 1 4546E+02  Z * 

Y - 0.106647E+02  Z * 

Y - 0 . 979873E+0 1 Z * 

Y « 0 . 88601 5E+01  Z * 

Y « 0.785 104E+01  Z * 

Y * 0.677160E+01  Z = 

Y « 0 . 56 1938E+01  Z = 

Y « 0 . 438777E+01  Z * 

Y * 0 . 30628 1 E+01  Z * 

Y * 0 . 1 6 1 463E+0 1 Z = 

Y « 0 . 593820E -04  Z * 

Y = 0. 143059E+02  Z = 

Y = 0. 1 42489E+02  Z = 

Y * 0. 1 407B8E+02  Z = 

Y = 0 . 1 38002E+02  Z * 

Y « 0.  1 34 1 98 E+02  Z = 

Y = 0. 1 29455E+02  Z = 


0.  144478E+02- 
O. 1 4384 1 E+02 
O.  14 1939E+02 
0.  1 38830E+02 
0. 1 34597E+02 
O.  1 29332E+02 
0. 1 23 120E+02 
0. 1 16036E+02 
0. 108 1 43E+02 
0 . 994887E+0 1 
0.901092E+01 
0 . 800250E+01 
0 . 692379E+01 
0 . 577235E+0 1 
0 . 454 1 58E+01 
0.321 752E+01 
0. 1 77032E+01 
0. 1 56840E+00 

0. 1 44707E+02 
0. 1 44 1 38E+02 
0.  142439E+02 
O. 1 39654E+02 
0. 1 35B54E+02 
0.1311 14E+02 


P SI  - 0. 1 1097E+00 

X - 0 . 900000E+01 

PSI  - 0.15 105E+00 

X « 0. 900000E+01 

PSI  * O. 19728E+00 
X - 0 . 900000E+01 

PSI  • 0.2496BE+00 

X - 0 . 900000E+01 

PSI  * 0.30623E+00 

X « 0. 900000E+01 

PSI  * 0 . 37295E+00 

X - 0 . 900000E+01 

PSI  * 0.44382E+00 

X « 0. 900000 E +01 

PSI  « 0.520B6E+00 

X - 0 . 900000E+01 

PSI  • O. 60404 E+00 
X « 0 . 900000E+01 

PSI  « 0 . 69339E+00 

X « 0 . 900000E+0 1 

PSI  * 0.78688E+00 

X * 0.900000E+01 

PSI  « 0.89053E+00 

X - 0 . 900000E +0 1 

PSI  * 0.9 9832E+00 

X * 0 . 900000E+0 1 


PSI  * O.OOOCOE+OO 
X * 0 . 950000E+0 1 

PSI  = 0.30828E-02 

X * 0 . 950000E+01 

PSI  * O. 1233 IE-01 
X « 0 . 950000E+0 1 

PSI  « 0.27745E-01 

X * 0.950000E+01 

PSI  * 0.49324E-01 

X - 0.950000E+01 

PSI  = 0 . 77067E-01 

X * 0.950000E+01 

PSI  = 0 . 1 1097E+00 

X * 0 . 950000E+01 

PSI  * 0. 1 5 105 E +00 

X * 0 . 950000E+01 

PSI  * 0 . 19728E+00 

X * 0 . 950000E+0 1 

PSI  = 0.24968E+00 

X = 0 . 950000E+01 

PSI  = 0 . 30823E+00 

X = 0.950000E+01 

PSI  = 0 . 37295E+00 

X = 0 . 950000E+0 1 


R « O . 85 1507E+01 
R - O . 854004E+01 
R - 0. 85679 1E+01 
R - O . 859849E+01 
R « O. 863165E+01 
R - 0.866730E+01 
R « 0 . 870539E+01 
R « 0.874593E+01 
R « 0 . 878905E+01 
R « 0 . 883501 E+01 
R « 0 . 888432E+01 
R « 0 . 893808E+01 
R = 0.899772E+01 

R = O . 890883E+01 
R = 0 . 89 1094E+01 
R = 0 . 89 1 722E+01 
R * 0.892755E+01 
R = 0 . 894 1 67E+0 1 
R = 0 . 895932E+0 1 
R = 0 . 898023E+01 
R = 0 . 9004 1 7 E+01 
R * 0.903092E+01 
R = O . 90603 1 E+0 1 
R = O . 902220E +0 1 
R = 0.91 2648E+01 


Y - O. 123847E+02 

Y « O. 1 17439E+02 

Y - 0. 1 10288E+02 

Y * 0. 102440E+02 

Y - 0.9393 1 1 E+01 

Y « 0 . 847844E+01 

Y - 0.7501 18E+01 

Y * O . 646079E+01 

Y - 0 . 535434E+01 

Y - 0.4175 1 8E+01 

Y * 0 . 290976E+0 1 

Y * 0.153036E+01 

Y = 0.377593E-04 

Y * 0 . 1431 22E+02 

Y « 0. 14261 1E+02 

Y = 0. 141081 E+02 

Y * 0 . 1 3857 1 E+02 

Y = 0. 135137E+02 

Y = 0 . 1 30B44E+02 

Y = 0. 1 25758E+02 

Y = 0.1 19936E+02 

Y = 0.11 3430E+02 

Y = O . 1 06282E+02 

Y = 0 . 98526 1 E+0 1 

Y = 0 . 90 1 885E+01 


2-0. 1 255 10E+02 
2 - 0.119 107E+02 
2-0. 111961 E+02 
2 - 0 . 104 1 20E+02 
2 - 0 . 956 1 70E+01 
Z » 0.864773E+01 
2 - O . 767 121 E+01 
2 - 0.663161 E+01 
2 - 0 . 552601 E+01 
2 - 0 . 434774E+01 
2 = O . 308328E+01 
2 « 0 . 1 70492E+01 
2 - 0 . 175767E+00 

Z - O. 1 44959E+02 
2 - O. 144448E+02 
Z = 0. 1 429 1 9E+02 
Z = 0. 14041 1 E+02 
Z - 0. 136980E+02 
2=0. 1 3269 1 E+02 
2 = 0. 127609E+02 
Z = 0. 1 2 1 792E+02 
Z = 0.1 1529 1 E+02 
2=0. 108 1 49E+02 
Z = 0.100400E+02 
Z = 0 . 920697  E+0 1 


PSI 


0 . 44382E+00 


X * 

0 . 950000E+01 

R 

m 

0.9163 10E+01 

Y 

m 

0.812848E+01 

Z 

m 

0. 83 1735E+01 

PSI 

X - 

- 0 . 52086E+00 

0 . 950000E+01 

R 

m 

0 . 920201 E+01 

Y 

B 

0. 7 18 196E+01 

Z 

* 

0.737164E+01 

PSI 

X - 

- 0 . 60404 E +00 

0 . 950000E+01 

R 

m 

0.924328E+01 

Y 

m 

0. 617825E+01 

z 

m 

0 . 636878E+01 

PSI 

X - 

« 0 . 69339E+00 

0.950000E+01 

R 

m 

0.928704E+01 

Y 

m 

0.51 1414E+01 

z 

s 

0.530557E+01 

PSI 
X * 

« 0 . 78888E+00 

0.950000E+01 

R 

K 

0.933355E+01 

Y 

m 

0 . 398290E+0 1 

z 

B 

0 . 4 17528E+01 

PSI 

X « 

« 0 . 89053E+00 

0 . 950000E+01 

R 

m 

0.938336E+01 

Y 

b 

0.277 1 53E+01 

z 

B 

0 . 296494E+01 

PSI 

X » 

« 0 . 99B32E+00 

0.950000E+01 

R 

B 

0 . 94375 1 E+01 

Y 

m 

0. 145455E+01 

z 

B 

0. 164907E+01 

PSI 

X * 

“ 0.11123E+01 

0.950000E+01 

R 

m 

0 . 949732E+01 

Y 

B 

0. 489373E-04 

z 

B 

0. 1 9580 1 E+00 

OLSTAD  RADIATION  MODEL 
BETA-BETA(Te) 


AT 

X 

n 

O 

. 1500D+01 

FOR 

BAND 

1 

OR  * 

0 . 8778D-01 

WATTS/SO. CM. 

FOR 

BAND 

2 

OR  ■ 

0.71 80D-01 

WATTS/SO. CM. 

FOR 

BAND 

3 

OR  * 

0.  1933D+00 

WATTS/SO. CM. 

FOR 

BAND 

4 

OR  = 

0.9876D-01 

WATTS/SO. CM. 

FOR 

BAND 

5 

OR  * 

0.4015D-01 

WATTS/SO. CM. 

FOR 

BAND 

6 

OR  * 

0 . 3330D+00 

WATTS/SO. CM. 

FOR 

BAND 

7 

OR  * 

0 . 5897D-09 

WATTS/SO. CM. 

FOR 

BAND 

6 

OR  = 

0.5748D+00 

WATTS/SO. CM. 

TOTAL  OR  * 

. 0. 1400D+01  WATTS/SO. CM. 

AT  ) 

< = O. 

. 2OOOD+01 

FOR 

BAND 

1 

OR  - 

0.  S265D-01 

WATTS/SO. CM. 

FOR 

BAND 

2 

OR  = 

0 . 8536D-01 

WATTS/SO. CM. 

FOR 

BAND 

3 

OR  * 

0.2305D+00  WATTS/SO. CM. 

FOR 

BAND 

4 

OR  = 

0.11 94D+00  WATTS/SO. CM. 

FOR 

BAND 

5 

OR  * 

0.4887D-01 

WATTS/SO. CM. 

FOR 

BAND 

6 

OR  = 

0.4038D+00 

WATTS/SO. CM. 

FOR 

BAND 

7 

OR  = 

0 . 3688D-05 

WATTS/SO. CM. 

FOR 

BAND 

8 

OR  = 

0.6846D+00 

WATTS/SO. CM. 

TOTAL  OR  = 0.1665D+01  WATTS/SO. CM. 


AT  X = 0.2500D+01 


AT  X « O . 80000+01 


FOR 

BAND 

1 

OR 

m 

0.38880+00  WATTS/SO. CM. 

FOR 

BAND 

2 

OR 

m 

0.6891D+00  WATTS/SO. CM. 

FOR 

BAND 

3 

OR 

m 

0. 1734D+01  WATTS/SO. CM. 

FOR 

BAND 

4 

OR 

K 

0 . 8759D+00  WATTS/SO. CM. 

FOR 

BAND 

5 

OR 

b 

0. 40960+00  WATTS/SO. CM. 

FOR 

BAND 

6 

OR 

B 

0.251 7D+01  WATTS/SO. CM. 

FOR 

BAND 

7 

OR 

m 

0.2719D-02  WATTS/SO. CM. 

FOR 

BAND 

8 

OR 

* 

0 . 2690D+01  WATTS/SO. CM. 

TOTAL  OR  * 0 . 9307D+01  WATTS/SO. CM. 

AT  X * 0.85000+01 

FOR 

BAND 

1 

OR 

K 

0.41 3 1D+00  WATTS/SO. CM. 

FDR 

BAND 

2 

OR 

m 

0.7440D+00  WATTS/SO. CM. 

FDR 

BAND 

3 

OR 

K 

0 . 1 846D+0 1 WATTS/SO. CM. 

FOR 

BAND 

4 

OR 

at 

0 . 9296D+00  WATTS/SO. CM. 

FOR 

BAND 

5 

OR 

x 

0.441 2D+00  WATTS/SO. CM. 

FOR 

BAND 

6 

OR 

& 

0 . 268 1D+01  WATTS/SO. CM. 

FOR 

BAND 

7 

OR 

B 

0.2757D-02  WATTS/SO. CM. 

FOR 

BAND 

8 

OR 

= 

0 . 28 14D+01  WATTS/SO. CM. 

TOTAL  OR  * O’. 98720+01  WATTS/SO. CM. 


at  ; 

< - 0 

.90000+01 

FOR 

BAND 

1 

OR 

c 

0.4364D+0C 

WATTS/SO. CM 

FOR 

BAND 

2 

OR 

c 

0 . 7967D+00 

WATTS/SO. CM 

FOR 

BAND 

3 

OR 

e 

0. 1952D+01 

WATTS/SO. CM 

FOR 

BAND 

4 

OR 

m 

0 . 9800D+00  WATTS/SO. CM 

FOR 

BAND 

5 

OR 

s 

0.471 5D+00 

WATTS/SO. CM 

FOR 

BAND 

6 

OR 

B 

0 . 2835D+01 

WATTS/SO. CM 

FOR 

BAND 

7 

OR 

= 

0.2786D-02 

WATTS/SO. CM 

FOR 

BAND 

B 

OR 

s 

0 . 2928D+01 

WATTS/SO. CM 

TOTAL  OR  * 0.1040D+02  WATTS/SO. CM. 


> 

H 

X 

if 

O 

9500D+01 

FOR  BAND 

1 

OR 

X 

0 . 4593D+00 

WATTS/SO. CM 

FOR  BAND 

2 

OR 

s 

0 . 8483D+00 

WATTS/SO. CM 

FOR  BAND 

3 

OR 

= 

0 . 2057D+0 1 

WATTS/SO. CM 

FOR  BAND 

4 

OR 

0. 1 029D+0 1 

WATTS/SO. CM 

FOR  BAND 

5 

OR 

0 . 50 1 3D+00 

WATTS/SO. CM 

FOR  BAND 

6 

OR 

= 

0 . 2986D+0 1 

WATTS/SO. CM 

6*7 


